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ABSTRACT 


The  cost  of  software  development  could  be  reduced  if  relevant  reusable  software 
components  could  be  retrieved  efficiently.  The  few  libraries  currently  in  existence  have 
no  standard  method  for  selecting  components  germane  to  the  intended  application.  This 
thesis  focuses  on  the  actual  formation  and  population  of  library  components  for  an 
improved  software  library  model  proposed  in  [Ref.  1].  This  library  would  provides  the 
codes  for  users  to  implement  the  desired  system  in  CAPS  environment. 

The  work  reported  here  consists  of:  identifying  candidate  reusable  components 
from  the  Booch  Ada  Library  -  by  manually  inspecting  over  500  components;  converting 
the  components  into  a  CAPS-compatible  format  based  on  the  Prototyping  System 
Description  Language  (PSDL)  via  Ada-PSDL  converter  program;  creating  algebraic 
specifications  to  match  the  semantic  description  of  each  component  manually;  and 
manually  organizing  the  library  into  a  data  structure  based  on  the  multi-level  filtering 
concept. 

This  work  provides  (1):  the  base  and  guidelines  for  the  (a)  criteria  for  a  reusable 
component;  (b)  process  of  inspecting  and  importing  components  into  CAPS  reusable 
component  library;  (2):  75  reusable  components  to  be  released  with  CAPS  95  and  used  to 
test  the  user  interface  for  retrieval  via  multi-level  filtering.  The  process  of  populating 
reusable  components  is  time  intensive  due  to  various  manual  processes.  Inspecting  and 
converting  each  component  sometimes  takes  up  to  an  hour  for  each.  Current  tools 
available  can  be  rewritten,  i.e.  the  PSDL-Ada  converter,  to  fully  automate  this  process  in 
accordance  with  the  base  and  guidelines. 
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I.  INTRODUCTION 


The  need  for  code  reuse  has  not  been  addressed  adequately  in  both  the  academic 
and  business  world.  In  the  business  world,  most  organizations  appear  to  offer  primitive 
incentives  to  encourage  a  culture  of  reuse.  However,  very  few  organizations  explicitly 
encourage  programmers  to  reuse  code,  or  to  write  code  that  is  reused.  Reuse  is  preached 
more  often  than  it  is  practiced.  In  the  academic  world,  the  word  has  been  used  but  the 
teaching  and  the  practices  are  also  hmited. 

One  of  the  reasons  for  this  is  the  lack  of  methods  for  effectively  finding  the 
components  needed  for  each  application  and  lack  of  component  libraries  organized  to 
support  such  methods.  With  the  current  trend  of  software  development,  prototyping  tools 
seem  to  be  the  key  for  rapid  developing  applications,  going  from  design  to  actual 
implementation  with  executable  code.  This  idea  of  reusable  code  is  instrumental  to  this 
prototyping  concept.  The  Department  of  Defense  has  long  endorsed  a  programming 
language  that  is  rigid  in  structure,  for  safety  of  operation  and  most  important  of  all  the 
reusability  of  codes.  Ada  is  the  standard  language  of  the  DOD  culture.  The  purpose  of 
this  thesis  is  to  provide  a  library  of  reusable  Ada  components  for  the  Computer  Aided 
Prototyping  System  (CAPS),  an  ongoing  research  project  at  the  Naval  Postgraduate 
School. 

A.  WHY  REUSE? 

Each  year,  billions  of  dollars  are  spent  on  computer  software.  Much  of  this  effort 
is  spent  on  creating  and  testing  new  source  code.  In  order  to  save  money,  increase 
productivity,  and  improve  reliability,  the  Department  of  Defense  is  constructing 
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repositories  of  reusable  software  components  that  can  be  used  across  applications.  A 
great  percentage  of  a  typical  program  is  composed  of  potentially  reusable  code  [Ref.  1] 
and  [Ref.  2].  It  is  desirable  to  make  use  of  existing  code  whenever  possible.  This  action 
can  significantly  reduce  the  amount  of  time  to  develop  the  software.  With  prototyping 
software  such  as  CAPS,  reusable  code  can  enhance  the  process  of  rapid  application 
development. 

This  approach  can  be  summarized  as  follows: 

•  Cost  savings. 

•  Early  payback. 

•  Manpower  savings. 

•  Technology  leverage  and  risk  mitigation. 

•  Reliability. 

B.  COMPUTER  AIDED  PROTOTYPING  SYSTEM 

The  Computer  Aided  Prototyping  System  is  a  software  engineering  tool  for 
developing  prototype  models  of  hard  real-time  embedded  systems  [Ref.  3]  and  [Ref.  6]. 
It  is  useful  for  requirements  analysis,  feasibility  studies,  and  the  design  of  large  embedded 
systems.  CAPS  is  based  on  the  Prototype  System  Description  Language  (PSDL),  which 
provides  facilities  for  modeling  timing  and  control  constraints  within  a  software  system 
[Ref.  4].  It  is  a  development  environment,  implemented  in  the  form  of  an  integrated 
collection  of  tools,  linked  together  by  a  user-interface  as  shown  in  Figure  1  [Ref.  5]. 


2 


Figure  1.  CAPS  Functionality  Overview  Diagram 

The  library  collected  in  this  thesis  is  part  of  the  Software  Base  component  of  the 
CAPS  functionality. 

C.  ORGANIZATION  OF  CHAPTERS 

Chapter  n  reviews  the  basic  concepts  and  terms  relevant  to  the  current  research  of 
CAPS  and  its  implementation.  Chapter  HI  focuses  on  the  implementation  of  the  database 
component  of  CAPS  and  the  data  structure  and  retrieval  method  for  these  reusable 
components.  Chapter  IV  concludes  the  research  and  discusses  the  user  interface  of  the 
software  base  component  of  CAPS. 
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n.  BACKGROUND  AND  PREVIOUS  RESEARCH 


This  chapter  describes  some  technical  background  about  CAPS  to  include  PSDL. 
Characteristics  of  reusable  components  and  methods  of  retrieval  are  the  two  primary 
topics  of  this  section.  Various  previous  research  and  current  systems  are  also  discussed. 

A.  CAPS  DESIGN  AND  COMPONENTS 

CAPS  is  an  integrated  environment  aimed  at  rapid  prototyping  hard  real-time 
embedded  systems  [Ref.  5]  and  [Ref.  6].  CAPS  tools  include  an  Ada  Compiler,  Design 
Database,  Graphic  Editor,  Syntax  Directed  Editor,  Software  Base,  Static  Scheduler, 
Dynamic  Scheduler,  and  Translator  as  shown  in  Figure  1.  Each  of  these  components 
provides  specific  functions  in  the  development  of  the  software. 

B.  PSDL 

PSDL  is  a  text  and  graphics  based  language  designed  to  express  the  specifications 
of  real-time  systems.  It  is  based  on  a  graphic  model  of  vertices  and  edges,  in  which  the 
vertices  represent  operators,  or  software  processes,  and  the  edges  represent  the  conceptual 
flow  of  data  from  one  operator  to  another.  Each  vertex  and  edge  may  have  associated 
timing  constraint,  and  the  vertices  may  have  associated  control  constraints. 

Formally,  the  model  used  is  that  of  an  augmented  graph,  G  =  (V,E,  T(v),C(v)) 
where  G  is  the  graph,  V  is  the  set  of  vertices,  E  is  the  set  of  edges,  T(v)  represents  the 
timing  constraints  for  the  vertices,  and  C(v)  represents  the  control  constraints  for  the 
vertices. 

Conceptually,  PSDL  operators  may  contain  other  operators  to  support  the 
principle  of  abstraction.  Effectively,  the  prototype  may  be  expressed  as  a  flat  graph,  or  a 
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one  level  graph  containing  all  the  atomic  operators  and  their  streams.  An  atomic  operator 
is  one  that  is  implemented  in  a  programming  language,  vice  a  composite  operator 
consisting  of  other  operators  and  streams. 

For  example,  the  following  diagram  shows  a  PSDL  prototype: 


Figure  2.  Example  of  PSDL  Graph 

Figure  2  represents  an  operation  modeled  by  the  Operator  A  that  accepts  one  item 
from  Stream  I,  it  performs  some  operation  on  the  data,  and  outputs  Stream  O.  The 
Maximum  Execution  Time  (MET),  this  is  the  maximum  possible  time  the  operator  may 
take  to  execute  the  task,  defined  as  400  milliseconds. 

Operator  A  can  further  be  decomposed  as  shown  in  Figure  3  below: 


Figure  3.  Decomposition  of  Operator  A 
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Operator  A  is  a  composite  operator,  while  Operator  A1  and  Operator  A2  are 
atomic  operators,  implemented  in  Ada  or  some  other  language.  The  timing  and  control 
constraints  on  these  atomic  operators  must  be  consistent  with  those  of  their  parent 
operator.  In  a  single  processor  the  combined  METs  of  these  atomic  operators  cannot  be 
greater  than  their  parent.  Operator  A  is  really  not  needed  for  implementation  of  this 
prototype;  it  serves  as  an  abstraction  of  the  functionality  of  the  children  operators.  More 
information  about  PSDL  can  be  founded  in  [Ref.  8]  and  [Ref.  9]. 

C.  OBJ3  AND  ALGEBRAIC  SPECIFICATION 

OBJ3  is  implemented  in  Common  Lisp,  and  is  based  on  ideas  from  order  sorted 
equational  logic  and  parameterised  programming.  OBJ3  provides  mixfix  syntax  (prefix, 
suffix,  and  infix),  flexible  subsorts  (subtypes  in  Ada  language),  parameterised  modules, 
views,  and  most  important  term  rewriting  modulo  associativity,  commutativity,  and 
identity.  OBJ  was  originally  designed  in  1976  by  Dr.  Goguen  [Ref.  10]. 

In  OBJ3,  an  algebraic  specification  of  objects  consists  of  two  parts:  a  signature 
and  a  set  of  axioms.  The  signature  defines  the  sorts  (or  types)  being  specified,  the 
operation  symbols,  and  the  axioms  define  their  functionality  in  an  object.  The  signature 
is  denoted  as  (S,  E)  where  S  and  E  are  a  sort  set  and  an  operation  symbol  set, 
respectively.  The  axioms  are  expressed  as  equations  describing  the  semantics  of  an 
object. 

D.  BASSE  DIAGRAM 

A  Basse  diagram  is  a  graphical  representation  of  a  partial  ordering  relation,  for 
which  the  following  properties  hold: 
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reflexive 


°  anti-symmetric 

°  transitive 

For  example:  the  Hasse  diagram  for  ({ 1,2,3,4}  <)  is  shown  in  Figure  4  below. 


Figure  4.  Constructing  the  Hasse  Diagram  for  ({ 1 ,2,3,4 },<) 

This  relation  is  called  partial  ordering.  In  Figure  4(a),  the  arrows  indicated  the 
relation  among  the  members,  since  all  members  hold  the  reflexive  property,  the  circle 
loops  can  be  eliminated  as  shown  in  Figure  4(b),  furthermore,  since  it  is  a  partial 
ordering,  all  arrows  implied  by  transitivity  can  be  removed,  as  shown  in  Figure  4(c).  This 
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concept  can  be  extended  to  partition  the  software  base,  in  which  profile  codes  define 
partitions  that  are  represented  as  a  Hasse  diagram. 

E.  PROFILE  MATCfflNG 

The  computation  for  parameter  matching  would  be  very  expensive  if  it  was 
necessary  to  try  all  possible  combinations  of  functions  and  data  types  with  those 
components.  For  example,  if  a  query  has  a  function  f:  AAB  ->  B  and  a  component  has  a 
function  g:  BA  ->  A,  these  two  functions  cannot  be  possibly  be  matched,  thus  there  is  no 
need  to  compute  this  combination.  The  purpose  of  profile  matching  is  to  speed  up 
parameter  matching.  Profile  matching  is  actually  an  efficient  approximation  of  signature 
matching.  A  profile  is  a  sequence  of  numbers  that  describes  how  data  types  are 
associated  with  an  operation.  It  is  defined  as  follows  [Ref.  1]: 

°  The  first  integer  is  the  total  number  of  occurrences  of  sorts  (data  types). 

°  If  the  total  number  of  sort  groups,  N  >  0,  then  the  second  to  (1  +  N)*  integers 
are  the  cardinalities  of  the  sort  groups,  in  descending  order. 

®  The  (2  +  N)***  integer  is  the  cardinality  of  the  unrelated  sort  group. 

"  The  (3+  N)*  integer  is: 

0  if  the  value  sort  is  different  from  any  of  the  argument  sorts;  and 

1  if  the  value  sort  belongs  to  some  sort  group. 

Sort  groups  are  bags  consisting  of  two  or  more  sort  occurrences  from  the  rank  of  the 

operation  that  are  related  under  the  relation  =,  which  is  the  transitive- 

symmetric  closure  of  the  ordering  <  on  sorts. 

Unrelated  is  a  set  of  all  sort  occurrences  that  are  not  in  any  sort  group. 
sort  group 


9 


For  example: 


Operation 

Profile  Code 

~>  A 

110 

AB->C 

330 

AA->B 

3210 

ABBCA  ->  C 

622201 

CCAAB->B 

622201 

Table  1.  Example  of  Profile  Code 
F.  CHARACTERISTICS  OF  A  REUSABLE  COMPONENT 

A  reusable  software  component  should  exhibit  the  best  characteristics  of  any  good 
piece  of  software.  Specifically,  it  should  be: 

•  maintainable 

•  efficient 

•  reliable 

•  understandable 

and  of  course,  correct.  However,  there  are  some  important  characteristics  specific 
to  reuse.  They  should  have  the  following  major  characteristics: 

•  generality 

•  definiteness 

•  transferability 

•  retrievability 

•  sufficiency 

•  completeness 

•  primitiveness 
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Generality  and  Definiteness:  for  example,  a  component  supplying  elementary 
real  functions  such  as  max,  min,  floor,  and  ceiling  is  a  good  candidate  for  reusability, 
because  these  operators  are  well  understood  and  are  applicable  to  a  wide  range  of 
problems;  this  address  the  issue  of  definiteness.  However,  to  facilitate  its  reuse,  we  must 
take  care  to  construct  such  a  component  independent  of  the  peculiarities  of  any 
application,  for  example,  the  representation  of  floating-point  numbers.  Ideally,  we  should 
factor  out  such  dependencies  and  achieve  generality.  The  Ada  language  has  a  mechanism 
to  implement  this  characteristic,  namely,  generics  and  instantiation. 

Transferability  and  Retrievability:  primarily  dealing  at  the  level  of  source  code, 
not  object  code.  Writing  a  component  as  an  Ada  generic  package  facilitates 
transferability,  for  here  we  have  a  mechanism  that  can  capture  many  of  the  relevant  parts 
of  an  abstraction.  However,  the  management  of  a  library  with  a  large  number  of 
components  can  be  a  great  concern.  The  larger  the  number  of  components  the  higher  the 
cost  of  finding  a  matching  component. 

Sufficiency:  the  component  captures  enough  characteristics  of  the  abstraction  to 
permit  meaningful  interaction  with  the  object. 

Completeness:  the  component  interface  captures  all  characteristics  of  the 
component.  Whereas  sufficiency  implies  a  minimal  collection  of  meaningful  operations, 
a  complete  set  of  operations  is  one  that  covers  all  aspects  of  the  underlying  abstraction. 
For  example,  the  abstraction  of  a  set  includes  the  notion  of  cardinality.  It  is  not  necessary 
to  include  an  operation  that  returns  the  cardinality  of  a  set;  we  can  interact  with  a  set 
without  this  capability.  However,  we  should  include  this  operation  to  enhance  the 
completeness  of  the  abstraction.  Completeness  is  a  subjective  measure  and  in  fact  can  be 
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overdone.  Supplying  all  meaningful  operations  for  a  particular  abstraction  is  not  only 
overwhelming  for  the  user,  but  generally  unnecessary,  since  many  high-level  operations 
can  be  composed  from  low-level  ones.  For  this  reason.  It  is  suggested  that  component 
operations  be  primitive. 

Primitiveness:  operations  that  can  be  implemented  only  with  access  to  the 
underlying  representation  of  the  object.  Thus,  adding  an  item  to  a  set  is  primitive, 
because  there  is  no  other  way  to  implement  this  operation  unless  the  underlying 
representation  is  visible.  However,  adding  four  items  to  a  set  is  not  primitive  since  it  can 
be  implemented  with  the  adding  one  item  iteratively  [Ref.  11]. 

G.  SOFTWARE  LIBRARIES 

1.  Asset  Source  for  Software  Engineering  Technology  (ASSET) 

ASSET  is  a  software  reuse  library  and  reuse  information  exchange  available  to 
software  developers  in  government,  industry,  and  education.  ASSET  is  sponsored  by 
ARPA's  STARS  (Software  Technology  for  Adaptable,  Reliable  Systems)  Program  to 
serve  as  a  national  resource  for  the  advancement  of  software  reuse  across  the  DoD.  The 
ASSET  library,  located  in  Morgantown,  WV,  is  connected  to  the  Internet  allowing  world¬ 
wide  access  to  reusable  software  assets.  ASSET'S  goals  are  to  create  a  focal  point  for 
software  reuse  information  exchange,  to  advance  the  technology  of  software  reuse 
processes  and  to  provide  an  electronic  marketplace  for  reusable  software  products,  and 
stimulate  a  national  software  reuse  industry. 

2.  Reusable  Ada  Package  for  Information  System  Development  (RAPID) 

The  RAPID  project  is  an  ongoing  effort  in  the  DoD.  The  objective  of  RAPID  is 

to  provide  software  engineers  with  quick  access  to  reusable  Ada  packages  in  the 


12 


information  system  domain.  The  system  performs  reusable  component  classification, 
storage  and  retrieval. 

3.  Common  Ada  Missile  Package  (CAMP) 

The  CAMP  project  is  also  sponsored  by  the  DoD  to  create  a  software  engineering 
system  of  reusable  software  library  of  components.  The  system  is  directed  toward 
software  for  missile  systems  and  uses  Ada  language  for  its  reusable  components. 

4.  Operation  Support  System  (OSS) 

The  OSS  is  an  ongoing  project  aimed  at  developing  and  integrated  software 
engineering  environment.  The  system  is  being  developed  at  the  Naval  Ocean  System 
Center.  One  of  the  goals  of  the  project  is  to  establish  a  Naval  software  library  of  reusable 
software  components. 

H.  METHODS  OF  RETRIEVAL 

1.  Keyword  Search  Method 

This  is  the  most  crude  method,  however  simplest  of  all.  There  is  no  data  structure 
in  storing  these  components.  The  user,  in  essence,  is  using  a  primitive  grep  UNIX 
command  to  search  for  a  word  that  associated  with  a  component.  The  useful  components 
found  by  this  method  is  extremely  poor  when  the  number  of  components  in  a  library  is 
large  since  the  set  of  retrieved  components  is  relatively  large.  This  requires  the  user  to 
browse  through  all  the  found  components  and  decide  which  of  the  components  is 
appropriate  for  usage.  There  is  no  way  of  placing  the  S5mtactic  and  semantic  information 
in  this  method.  However,  from  informal  survey  of  current  progranuners  in  the  private 
industry,  this  method  is  very  popular.  This  may  not  be  a  surprise  due  to  the  fact  that  there 
is  no  standard  in  retrieving  reusable  components. 
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2.  Artificial  Intelligence  Methods 

Artificial  Intelligence  methods  include  [Ref.  9]  and  [Ref.  10],  and  some  recent 
work  by  Henninger  [Ref.  14],  which  uses  a  knowledge  base  and  statistical  information  to 
retrieve  reusable  components,  based  on  keyword  search  from  texts  describing  the 
components.  However,  because  the  characterization  of  the  component  behavior  is 
completely  informal,  the  behavior  is  unpredictable  [Ref.  15]. 

3.  Multi-Level  Filtering  Method 

This  method  is  proposed  in  [Ref.  1],  in  which  a  combination  of  retrieval  processes 
are  used.  The  process  is  represented  as  follows: 


A 

■ 

Profile  & 
Keyword 
Filtering 

Signature 

Matching 

i 

Ground 

Equation 

Checking 

Ranked 
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_J 

Figure  5.  Model  for  the  Multi-Level  Filtering  Process 
In  this  method,  search  is  organized  as  a  series  of  increasingly  stringent  filters  on 
candidate  components.  We  first  filter  components  by  comparing  their  signatures  with 
that  of  the  query.  This  is  accomplished  by  signature  matching,  which  looks  for  maps  that 
translate  the  type  and  function  symbols  of  the  query  into  corresponding  type  and  function 
symbols  of  candidate  components.  A  first  stage  of  signature  filtering  can  compare  pre¬ 
computed  syntactic  profiles  of  components  with  the  profile  of  the  query.  These  profiles 
are  special  data  structures  that  support  an  efficient  approximation  of  signature  matching. 
The  key  property  of  a  profile  is  that  two  operation  signatures  cannot  have  a  syntactic 


14 


match  unless  their  computed  profiles  are  equal.  Signature  matches  can  be  partial,  in  that 
only  part  of  the  functionality  the  user  seeks  may  actually  be  available.  The  profile  of  an 
abstract  data  type  is  a  bag  containing  the  profile  codes  of  its  operations.  In  a  partial 
signature  match,  a  subset  of  the  query  profile  is  contained  in  the  stored  component’s 
profile.  Traditional  search  methods,  such  as  keyword  search,  could  also  be  used  as  early 
filters.  Profile  matching  should  be  followed  by  full  signature  matching. 

Semantic  filters  rank  components  by  how  well  they  satisfy  the  equations  in  the 
query.  In  this  process,  equations  that  are  logical  consequences  of  the  query  specification 
are  translated  through  the  signature  matches  into  equations  whose  proof  is  attempted  in 
the  candidate  specifications.  This  whole  process  can  be  made  iterative. 
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III.  DESIGN  AND  CONCEPTS 


A.  BOOCHLffiRARY 

The  Booch  library  divided  into  three  categories:  data  structure,  tools,  and 
subsystems.  A  data  structure  is  a  component  that  denotes  an  object  or  class  of  objects 
characterized  as  an  abstract  state  machine  or  an  abstract  data  type.  A  tool  is  a  component 
that  denotes  an  algorithmic  abstraction  targeted  to  an  object  or  class  of  objects.  A 
subsystem  is  a  component  that  denotes  a  logical  collection  of  cooperating  structures  and 
tools.  Each  category  is  further  divided  into  subcategories  as  shown  in  Figure  6  below. 


Reusable 

Software 

Components 


Figure  6.  Booch  Library 
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Monolithic  the  structure  is  always  treated  as  a  single  unit  and  that  individual  parts  of 
the  structure  can  not  be  manipulated. 

Polylithic  the  structure  is  composed  of  individual  parts  that  can  be  manipulated. 

There  are  over  500  components  in  the  Booch  library  in  many  different  forms.  It 


often  happens  that  there  is  a  software  part  that  we  want  to  reuse,  but  it  is  not  exactly  in 
the  light  form  [Ref.  16].  Figure  7  below  presents  the  forms  of  reusable  software 
component  that  have  been  found  to  be  common  across  many  applications  [Ref.  1 1]. 
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Figure  7.  The  forms  of  a  reusable  software  component 
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Sequential 


Guarded 


Concurrent 


Multiple 


Bounded 

Unbounded 

Unmanaged 

Managed 

Controlled 

Noniterator 


The  semantics  of  an  object  are  preserved  only  in  the  presence  of  one 
thread  of  control  for  each  instance  of  the  type. 

The  semantics  of  an  object  are  preserved  in  the  presence  of  multiple 
threads  of  control,  if  mutual  exclusion  is  enforced  by  all  clients  of  the 
object. 

The  semantics  of  an  object  are  preserved  in  the  presence  of  multiple 
threads  of  control,  and  mutual  exclusion  is  enforced  by  the  object  itself. 
Access  by  multiple  clients  is  sequentialized. 

The  semantics  of  an  object  are  preserved  in  the  presence  of  multiple 
threads  of  control,  and  mutual  exclusion  is  enforced  by  the  object  itself. 
Multiple  simultaneous  readers  are  permitted,  but  writers  are 
sequentialized. 

Denotes  that  the  size  of  the  object  is  static. 

Denotes  that  the  size  of  the  object  is  dynamic. 

Automatic  garbage  collection  is  the  responsibility  of  the  underlying  run 
time  system  and  compiler. 

Garbage  collection  is  provided  by  the  component  itself,  and  the  type  is 
used  only  by  a  single  task. 

Garbage  collection  is  provided  by  the  sequential  component  itself  even  if 
the  type  is  used  by  multiple  tasks.* 

An  iterator  is  not  provided  for  this  object. 


'  Sequential  controlled  means  several  tasks  can  each  have  a  private  instance  of  the  type. 
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Iterator  An  iterator  is  provided  for  this  object. 

Together,  these  forms  offer  a  total  of  26  meaningful  combinations.  The  Appendix 
lists  the  imported  components. 

The  components  in  the  library  conform  to  the  following  file  name  convention: 


assuming  the  file  name  of  the  component  is  stackssbmn. 


Description 

File  Name 

Ada  specifications 

vstackssbmn.a 

Ada  implementation 

bstackssbmn.a 

PSDL 

vstackssbmn.psdl 

OBJ3  specifications 

vstackssbmn.obj 

Profile  code 

vstackssbmn.code 

Table  2.  Example  of  file  name  convention 
There  are  75  components  imported  into  this  library.  These  components  are  the 
samples  of  each  of  the  data  structure  components  in  the  Booch  library.  This  should  give  a 
broad  base  number  of  the  components  for  the  reusable  components. 

B.  POPULATING  PROCESS 


Figure  8.  Populating  Process 
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Components  must  be  manually  inspected  for  reusability  criteria  listed  in  Chapter 
n.  In  the  CAPS  system,  a  PSDL  specification  is  an  integrated  part  of  a  reusable 
component.  By  adding  procedure  versions  of  functions,  PSDL  specifications  can  be 
readily  generated  by  a  converter  written  by  [Ref.  17]. 

Each  step  of  the  populating  process,  shown  in  Figure  8,  is  illustrated  in  this 
section  by  an  example.  An  example  of  the  first  step,  adding  procedure/function 


replacement,  follows: 

SPECIFICATIONS 


generic 

type  Item  is  private; 

package  Stack_Sequential_Bounded_Managed_Iterator  is 


type  Stack (The_Size  :  Positive)  is  limited  private; 


procedure 

Copy 

( From_The_S  t ack 

in 

stack; 

To_The_Stack 

in 

out 

Stack) ; 

procedure 

Clear 

(The_Stack 

in 

out 

Stack) ; 

procedure 

Push 

{The_Item 

in 

Item; 

On_The_Stack 

in 

out 

Stack) ; 

procedure 

Pop 

(The_Stack 

in 

out 

Stack) ; 

modified  by  Tuan  Nguyen 
replacing  functions  with  procedures 

procedure  Is_E<iual  (Left  :  in  Stack; 

Right  :  in  Stack; 

Result  :  out  Boolean) ; 

procedure  Depth_Of  (The_Stack  :  in  Stack; 

Result  :  out  Natural); 

procedure  Is_EiDpty  {The_Stack  :  in  Stack; 

Result  :  out  Boolean) ; 

procedure  Top_Of  (The_Stack  :  in  Stack; 

Result  :  out  Item) ; 


end  of  modification 


function  Is_Equal 
Boolean; 


(Left 

Right 


in  Stack; 
in  Stack)  return 


function  Depth_Of 
Natural ; 


(The_Stack  :  in  Stack)  return 
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function  Is_Empty  (The_Stack  :  in  Stack)  return  Boolean; 

function  Top_Of  (The_Stack  :  in  Stack)  return  Item; 

generic 

with  procedure  Process  (The_Item  :  in  Item; 

Continue  :  out  Boolean) ; 
procedure  Iterate  (Over_The_Stack  :  in  Stack) ; 

Overflow  :  exception; 

Underflow  :  exception; 

private 

type  Items  is  array (Positive  range  <>)  of  I tern; 
type  Stack (The_Size  :  Positive)  is 
record 

The_Top  :  Natural  :=  0; 

The_Items  :  Items (1  ..  The_Size) ; 

end  record; 

end  Stack_Sequential_Bounded_Managed_I terator ; 

IMPLEMENTATION 

package  body  Stack_Sequential_Bounded_Managed_Iterator  is 

procedure  Copy  (From_The_Stack  :  in  Stack; 

To_The_Stack  :  in  out  Stack)  is 

begin 

if  From_The_Stack . The_Top  >  To_The_Stack. The_Size 

then 

raise  Overflow; 

else 

To_The_Stack . The_Items (1  . . 

Fr om_The_S  tack . The_Top )  :  = 

From_The_Stack. The_I terns (1  .. 

From_The_Stack . The_Top ) ; 

To_The_Stack.The_Top  :=  From_The_Stack.The_Top; 
end  if; 
end  Copy; 

procedure  Clear  (The_Stack  :  in  out  Stack)  is 
begin 

The_Stack . The_Top  : =  0 ; 
end  Clear; 

procedure  Push  (The_Item  :  in  Item; 

On_The_Stack  ;  in  out  Stack)  is 

begin 

On_The_Stack.The_Items (On_The_Stack.The_Top  +1)  := 

The_Item; 

On_The_Stack . The_Top  :=  On_The_Stack . The_Top  +  1; 
exception 

when  Constraint_Error  => 
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raise  Overflow; 
end  Push; 

procedure  Pop  (The_Stack  :  in  out  Stack)  is 
begin 

The_Stack.The_Top  :=  The_Stack. The_Top  -  1; 
exception 

when  Constraint_Error  => 
raise  Underflow; 

end  Pop; 

—  modified  by  Tuan  Nguyen 

replacing  procedures  with  functions 

procedure  Is_Equal  (Left  :  in  Stack; 

Right  :  in  Stack; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is_Equal (Left, Right) ; 
end  Xs_Equal; 

procedure  Depth_Of  (The_Stack  :  in  Stack; 

Result  :  out  Natural)  is 

begin 

Result  :=  Depth_Of (The_Stack) ; 
end  Depth_Of; 

procedure  Is_Eii^ty  (The_Stack  :  in  Stack; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is_Empty(The_Stack) ; 
end  Is_Eii5>ty; 

procedure  Top_Of  (The_Stack  :  in  Stack; 

Result  :  out  Item)  is 

begin 

Result  :=  Top_Of (The_Stack) ; 
end  Top_Of; 

end  of  modification 

function  Is_Egual  (Left  :  in  Stack; 

Right  :  in  Stack)  return  Boolean  is 

begin 

if  Left.The_Top  /-  Right . The_Top  then 
return  False; 

else 

for  Index  in  1  . .  Left.The_Top  loop 
if  Left .The_I terns (Index)  /= 

Right . The_I terns ( Index )  then 

return  False; 
end  if; 
end  loop; 
return  True; 
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end  if; 
end  Is_Eq:ual; 


function  Depth_Of  (The_Stack  :  in  Stack)  return  Natural 
is 

begin 

return  The_Stack.The_Top; 
end  Depth_Of; 

function  Is_Empty  {The_Stack  :  in  Stack)  return  Boolean 
is 

begin 

return  (The_Stack.The_Top  =  0) ; 
end  Is_Empty; 

function  Top_Of  (The_Stack  :  in  Stack)  return  Item  is 
begin 

return  The_Stack.The_Items(The_Stack.The_Top); 
exception 

when  Constraint_Error  => 
raise  Underflow; 
end  Top_Of; 

procedure  Iterate  {Over_The_Stack  :  in  Stack)  is 
Continue  :  Boolean; 
begin 

for  The_Iterator  in  reverse  1  . . 
Over_The_Stack.The_Top  loop 

Process (Over_The_Stack.The_Items (The_Iterator) , 

Continue) ; 

exit  when  not  Continue; 
end  loop; 
end  Iterate; 

end  Stack_Seguential_Bounded_Managed_Iterator; 

This  procedure  is  necessary  to  match  the  code  interface  conventions  of  the  current 
implemementation  of  CAPS.  The  next  step  is  to  generate  the  PSDL  specification  for  the 
component.  The  converter  program  will  generate  the  PSDL  automatically  with  the 
following  command: 

ada2psdl  filename  (without  any  extension) 

The  output  file  will  have  the  same  name  as  the  file  name  with  the  psdl  extension. 
The  generated  file  for  the  above  example  follows: 
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PSDL 


TYPE  Stack_Sequential_Bounded_Managed_Iterator 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

From_The_Stack  :  Stack, 

To_The_Stack  :  Stack 
OUTPUT 

To_The_Stack  :  Stack 
EXCEPTIONS 

Overflow 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Stack  :  Stack 
OUTPUT 

The_Stack  :  Stack 

END 

OPERATOR  Push 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

On_The_Stack  :  Stack 
OUTPUT 

On_The_Stack  :  Stack 
EXCEPTIONS 

Overflow 

END 

OPERATOR  Pop 
SPECIFICATION 
INPUT 

The_Stack  :  Stack 
OUTPUT 

The_Stack  :  Stack 
EXCEPTIONS 

Underflow 

END 

OPERATOR  Is_Equal 
SPECIFICATION 
INPUT 

Left  :  Stack, 

Right  :  Stack 
OUTPUT 

Result  :  Boolean 
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END 


OPERATOR  Depth_Of 

SPECIFICATION 

INPUT 

The_Stack  :  Stack 
OUTPUT 

Result  :  Natural 

END 

OPERATOR  Is_Empty 

SPECIFICATION 

INPUT 

The_Stack  :  Stack 
OUTPUT 

Result  :  Boolean 

END 

OPERATOR  Top_Of 

SPECIFICATION 

INPUT 

The_Stack  :  Stack 
OUTPUT 

Result  :  Item 
EXCEPTIONS 

Underflow 

END 

OPERATOR  Iterate 

SPECIFICATION 

GENERIC 

Process  :  PROCEDURE [The_I tern  :  in[t  :  Item],  Continue 
:  out[t  :  Boolean]] 

INPUT 

Over_Tlie_Stack  :  Stack 

END 

END 

IMPLEMENTATION  ADA  Stack_Sequential_Bounded_Managed_Iterator 
END 


Each  procedure  in  Ada  specifications  is  associated  with  an  operator  in  PSDL.  The 


input  and  output  streams  in  PSDL  correspond  to  the  procedure  input/output  parameters. 


The  package  must  then  be  re-compiled  for  quality  assurance. 


OBJ3  specifications  are  created  next  in  accordance  with  the  guideline  in  Chapter 


II.  The  following  is  an  example  of  this  step  (for  the  previous  Ada  specifications): 
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STACK  0JB3  SPECIFICATION: 


obj  STACK [X  ::  TRIV]  is  sort  Stack  . 
protecting  NAT  . 


***  constructors 


op  create 
op  copy 
op  clear 
op  push 
op  pop 

***  accessors 

op  is equal 
op  depthof 
op  is empty 
op  topof 

***  exceptions 


->  Stack  . 
Stack  Stack  ->  Stack  . 

Stack  ->  Stack  . 

Elt  Stack  ->  Stack  . 

Stack  ->  Stack  . 


Stack  Stack  ->  Bool  . 
Stack  ->  Nat  . 
Stack  ->  Bool  . 
Stack  ->  Elt  . 


op  underflow  :  ->  Stack  . 
op  underflow  :  ->  Elt  . 


***  variables  declaration 


var  S  SI  :  Stack  . 
var  E  El  :  Elt  . 


***  axioms 

eq  clear (S)  =  create  . 

eq  copy (S, SI)  =  S  . 

eq  pop (create)  =  underflow  . 
eq  pop (push (E, S) )  =  S  . 

eq  isequal (S, SI)  =  S  ==  Si  . 

eq  depthof (S)  =  if  S  ==  create  then  0 

else  1  +  depthof (pop (S) )  fi 

eq  isempty(S)  =  S  ==  create  . 

eq  topof (create)  =  underflow  . 
eq  topof (push (E, S) )  =  E  . 

endo 
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The  next  step  is  to  create  the  profile  code: 

From  either  the  Ada  specifications  or  PSDL: 

procedure  Copy  (Froin_The_Stack  :  in  Stack; 

To_The_Stack  :  in  out  Stack) ; 

has  the  signature  AB  ->  B 

°  first  digit  is  the  number  of  sort  occurrences:  3 
°  the  number  of  sort  groups  is  1  thus  N  =  1; 

°  (1  +  N)*  digit  is  the  cardinality  of  the  sort  group 
°  second  digit  (1  +  1)  is  :  2  since  l[BB]l  =  2 
°  third  digit  (2  +  1)  is  :  1  since  [A]  is  the  only  unrelated  sort  group 
°  fourth  digit  (3  +  1)  is  :  1  since  B  belongs  to  the  sort  group 

thus:  profile(Copy)  =  3211 

procedure  Clear  (The_Stack  :  in 

Clear:  A  ->  A  has  profile  2201 

procedure  Push  (The_Item  :  in 

On_The_Stack  :  in 

Push:  AB  ->  B  has  profile  3211 

procedure  Pop  (The_Stack 

Pop:  A  ->  A  has  profile  2201 

procedure  Is_Equal  (Left  :  in  Stack; 

Right  :  in  Stack; 

Result  :  out  Boolean) ; 

Is_Equal:  AB  ->  C  has  profile  330 

procedure  Depth_Of  (The_Stack  :  in  Stack; 

Result  :  out  Natural) ; 

Depth_Of:  A  ->  B  has  profile  220 

procedure  Is_Empty  (The_Stack  :  in  Stack; 

Result  :  out  Boolean) ; 

Is_Empty:  A  ->  B  has  profile  220 

procedure  Top _ Of  (The_Stack  :  in  Stack; 

Result  :  out  Item) ; 


out  Stack) ; 


Item; 

out  Stack) ; 


:  in  out  Stack) ; 
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Top_Of:  A  ->  B  has  profile  220 
Summaiy: 


Table  3.  Summary  of  Stack  Profile  Code 
The  profile  codes  from  these  components  will  then  be  partitioned  and  represented 
by  a  Hasse  diagram  to  optimize  the  multi-filtering  retrieval  method. 
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rv.  CONCLUSIONS  AND  FUTURE  RESEARCH 


This  chapter  summarizes  the  concept  and  the  process  of  populating  the  software 
base.  Lessons  learned  and  suggestions  for  future  research  are  also  mentioned  in  this 
section. 

A.  ACCOMPLISHMENT 

This  thesis  has  described  the  process  of  populating  the  software  base  and  relevant 
method  for  retrieval,  namely,  multi-level  filtering  concept.  The  components  selected 
comprise  the  base  library  listed  in  the  Appendix,  which  can  be  used  for  future  study  and 
testing  of  the  multi-level  filtering  process.  This  process  is  labor  intensive  and  many 
automation  issues  should  be  investigated  further.  Preliminary  study  of  the  retrieval  has 
been  very  promising  [Ref.  18]. 

B.  LESSONS  LEARNED 

The  process  is  time  intensive.  Not  all  components  can  be  reused.  The  primary 
difference  between  engineering  reusable  components,  i.e.  nuts  and  bolts,  and  software 
engineering  is  continuity  in  dimension.  A  nut  will  be  manufactured  only  in  certain 
dimensions  such  as  5/8”  but  a  graphical  representation  of  a  nut  in  software  engineering 
can  be  any  size. 

The  writing  of  the  OBJ3  specifications  associated  with  each  component  is  the 
most  difficult  task  of  all.  OBJ3  is  a  functional  language,  however  Ada  components  are 
written  with  procedures.  Thus  multiple  out  parameters  cannot  be  directly  implemented. 
The  rationale  for  using  OBJ3  is  to  attach  the  semantics  of  the  operations  to  each  data 
type.  By  attaching  this  specification  to  a  component  the  system  can  refine  the  retrieving 
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process.  The  user  can  accurately  retrieve  the  matched  component  via  this  specification. 
However,  the  user,  most  of  the  time,  does  not  search  for  an  exact  component,  just  for  an 
approximation  of  the  component.  The  user  must  and  should  inspect  and  modify  the 
component  found  to  meet  his/her  requirements.  Thus  completely  detailed  OBJ3 
specifications  may  not  be  that  critical.  For  example:  a  bounded  stack  will  have  an 
overflow  exception  in  its  specification.  This  aspect  cannot  be  easily  handled  during 
semantic  matching.  Consequently,  the  user  must  supply  the  size  parameter  during 
instantiation.  This  exception  can  be  omitted  in  the  OBJ3  specification  because  the 
semantic  matching  process  cannot  use  the  information.  A  more  appropriate  treatment  of 
the  exception  is  to  include  an  informal  explanation  sufficient  to  guide  the  user  in 
instantiating  the  size  bound.  The  informal  description  part  of  the  PSDL  specification  can 
be  used  for  this  purpose. 

C.  FUTURE  RESEARCH 

1.  Graphical  User  Interface 

A  graphical  user  interface  can  make  the  retrieval  process  less  error  prone.  The 
user  would  not  need  to  be  an  expert  in  how  the  software  base  works.  This  interface  will 
increase  productivity. 

2.  CAPS  and  the  Internet 

Currently,  CAPS  can  be  used  on  a  local  area  network  Unix  environment  or  a  stand 
alone  Unix  workstation.  There  is  a  plan  to  implement  CAPS  on  another  microprocessor 
base,  namely,  the  Intel  architecture  microprocessor.  However,  CAPS  can  be  used  across 
platforms  via  the  Internet.  JavaScript,  based  on  the  Java  language  (a  derivative  of  the 
C++  language),  and  the  Internet  can  make  this  possible.  JavaScript  extends  the 
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programmatic  capabilities  of  a  typical  Internet  browser,  i.e.  Netscape,  to  a  wide  range  of 
authors  and  is  easy  enough  for  anyone  who  can  compose  Hyper  Text  Markup  Language 
(HTML).  JavaScript  can  be  used  to  glue  HTML,  inline  plug-ins,  and  Java  applets 
(applications)  to  each  other.  It  provides  the  ability  to  change  images,  play  different 
sounds,  and  more  in  response  to  specified  events  such  as  a  user  mouse  click  or  screen  exit 
and  entry. 

The  JavaScript  language  resembles  Java,  but  without  Java's  static  typing  and 
strong  type  checking.  JavaScript  supports  most  of  Java's  expression  syntax  and  basic 
control  flow  constructs,  hi  contrast  to  Java's  compile-time  system  of  classes  built  by 
declarations,  JavaScript  supports  a  run-time  system  based  on  a  small  number  of  primitive 
types.  The  members  of  numeric,  boolean,  and  string  types  can  be  expressed  literally. 

Primitive  types  can  be  composed  into  objects  by  setting  properties  with  the 
assignment  operator.  JavaScript  also  supports  functions,  again  without  any  declarative 
requirements  beyond  the  need  to  distinguish  a  function  definition  from  other  sentences  in 
the  language.  Functions  can  be  properties  of  objects,  executing  as  loosely-typed  methods. 

JavaScript  complements  Java  by  exposing  useful  properties  of  Java  applets  to 
script  authors.  JavaScript  scripts  embedded  in  HTML  documents  can  get  and  set  exposed 
properties  in  order  to  query  the  state  or  alter  the  performance  of  an  applet  or  plug-in. 

Java  is  an  extension  language  designed,  in  particular,  for  fast  execution  and  type 
safety.  (Type  safety  is  reflected  by  being  unable  to  cast  a  Java  int  into  an  object  reference 
or  to  get  at  private  memory  by  corrupting  Java  bytecodes).  Java's  strong  typing  also 
increases  compilation  efficiency  of  Java  bytecode  to  machine  code. 
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Java  programs  consist  exclusively  of  classes  and  their  methods.  Java's 
requirements  for  declaring  classes,  writing  methods,  and  ensuring  type  safety  make 
programming  more  complex  than  JavaScript  authoring.  Java's  inheritance  and  strong 
typing  also  tend  to  require  tightly  coupled  object  hierarchies. 

In  contrast,  JavaScript  descends  in  spirit  from  a  line  of  smaller,  dynamically-typed 
languages  like  HyperTalk  and  Dbase.  These  scripting  languages  offer  programming  tools 
to  a  much  wider  audience  because  of  their  easier  syntax,  specialized  built-in  functionality, 
and  minimal  requirements  for  object  creation. 

In  summary,  JavaScript  can  be  used  to  implement  World  Wide  Web  access  to 
various  aspects  of  CAPS.  For  example,  a  graphical  user  interface,  written  in  JavaScript, 
can  enable  the  user  to  retrieve  a  component  from  the  Software  Base  library.  JavaScript 
can  provide  dialog  boxes,  error  messages,  and  help  systems.  These  features  enable  the 
user  to  interact  with  CAPS  via  the  Internet  without  having  to  fully  implement  CAPS 
locally.  Multimedia  (video  and  audio)  can  be  distributed  over  the  Internet  as  a  marketing 
tool  for  CAPS. 
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APPENDIX  -  LIBRARY  COMPONENTS 


BOOCH  LffiRARY  COMPONENTS 

The  following  lists  are  grouped  by  major  component  class. 


Bags 


1 

Bag_Simple_Sequential_Bounded_Managed_Iterator 

2 

Bag_Simple_Sequential_Bounded_Managed_Noniterator 

3 

Bag_Simple_Sequential_Unbounded_Managed_Iterator 

■ 

Bag_Simple_Sequential_Unbounded_Managed_Noniterator 

5 

Bag_Simple_Sequential_Unbounded_Unmanaged_Iterator 

6 

Bag_Simple_Sequential_Unbounded_Unmanaged_Noniterator 

Lists 


1 

List_Double_Bounded_Managed 

2 

List_Double_Unbounded_Managed 

3 

List_Double_Unbounded_Unmanaged 

H 

List_Single_Bounded_Managed 

5 

List_Single_Unbounded_Managed 

6 

List_Single_Unbounded_Unmanaged 
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Maps 


1 

Map_'^imp1ft_Nnncached  Sequential  Bounded  Managed_Iterator 

2 

Map_Simple_Noncached_Sequential_Bounded_Managed_Noniterator 

3 

Map_Simple_Noncached_Sequential_Unbounded_Managed_Iterator 

4 

Map_Simple_Noncached_Sequential_Unbounded_Unmanaged_Noniterator 

5 

Map_Simple_Noncached_Sequential_Unbounded_Unnianaged_Iterator 
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Queues 


1 

Queue_Nonpriority_Balking_Sequential__Bounded_Managed_Iterator 

2 

Queue_Nonpriority_Bal]dng_Sequential_Unbounded_Managed_Noniterator 

3 

Queue_Nonpriority_Nonbalking_Sequential_Bounded_Managed_Iterator 

H 

Queue_Nonpriority_Nonbalking_Sequential_Unbounded_Managed_Noniterator 

5 

Queue__Priority_Balking_Sequential_Bounded_Managed_Iterator 

6 

Queue_Priority_Balking_Sequential_Unbounded_Managed_Noniterator 

7 

Queue_Priority_Nonbalking_Sequential_Bounded_Managed_Iterator 

8 

Queue_Priority_NonbaIking_Sequential_Unbounded_Managed_Noniterator 

9 

Queue_Nonpriority_Balking_Sequential_Unbounded_Unmanaged_Iterator 

10 

Queue_Nonpriority_Nonbalking_Sequential_Unbounded_Uninanaged_Iterator 

11 

Queue_Priority_Balking_Sequential_Unbounded_Unmanaged_Iterator 

12 

Queue_Priority_Nonbalking_Sequential_Unbounded_Unmanaged_Iterator 

13 

Queue_Nonpriority_BaIldng_Sequential_Unbounded_Managed_Iterator 

14 

Queue_Nonpriority_Balking_Sequential_Unbounded_Unmanaged_Noniterator 

15 

Queue_Nonpriority_Nonbalking_Sequential_Unbounded_Unmanaged_Noniterator 

16 

Queue_Priority_Balking_Sequential_Unbounded_Managed_Iterator 

17 

Queue_Priority_Balking_Sequential_Unbounded_Unnianaged_Noniterator 

18 

Queue_Priority_Nonbalking_Sequential_Unbounded_Unmanaged_Noniterator 
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Rings 


1 

Ring_Sequential_Bouaded_Managed_Iterator 

2 

Ring_SequentiaI_Bounded_Managed_Noniterator 

3 

Ring_5>ftqiientia]JLJnbounded  Managed  Iterator 

H 

Ring_Sequential_Unbounded_Managed_Noniterator 

5 

Ring_Sequential_Unbounded_Managed_Iterator 

6 

Ring_Sequential_Unbounded_Managed_Noniterator 

Sets 


1 

Set_Simple_Sequential_Bounded_Managed_Iterator 

2 

Set_Simple_Sequential_Bounded_Managed_Noniterator 

3 

Set_Simple_Sequential_Unbounded_Managed_Iterator 

H 

Set_Simple_Sequential_Unbounded_Managed_Noniterator 

5 

Set_Simple_Sequential_Unbounded_Unmanaged_Iterator 

6 

Set_Siinple_Sequential_Unbounded_Unmanaged_Noniterator 
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Sorts  &  Searchs 


1 

Binary_Search 

2 

Binary_Insertion_Search 

3 

Buble_Sort 

H 

Heap_Sort 

5 

N  atural_Merge_Sort 

6 

Ordered_Sequential_Search 

7 

Poly_Sort 

8 

Quick_Sort 

9 

Radix_Sort 

10 

Sequential_Search 

11 

Shaker_Sort 

12 

Shell_Sort 

13 

Straight_Insertion_Sort 

14 

Straight_Selection_Sort 

Stacks 

1 

Stack_Sequential_Bounded_Managed_Iterator 

2 

Stack_Sequential_Unbounded_Managed_Noniterator 

3 

Stack_Sequential_Unbounded_Managed_Iterator 

■ 

Stack_Sequential_Unbounded_Unmanaged_Noniterator 

Stack_Sequential_Unbounded_Unmanaged_Iterator 

Storage 


1 

Storage_Sequence 

Strings 

1 

String_Sequential_Unbounded_Controlled_Iterator 

2 

String_Sequential_Unbounded_Managed_Iterator 

3 

String_Sequential_Bounded_Unmanaged_Noniterator 

■ 

String_Sequential_Unbounded_Unmanaged_Noniterator 

Trees 


1 

Tree_Arbitrary_Double_Bounded_Unmanaged 

2 

Tree__Arbitrary_Double_Unbounded__Unmanaged 

3 

Tree_Arbitrary_Single_Bounded_Unmanaged 

■ 

Tree_Arbitrary_Single_Unbounded_Unmanaged 
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BAG  OBJ3  SPECIFICATIONS 


obj  BAG [x  : ;  TRIV)  is  sort  Bag  . 
protecting  NAT  . 

***  constructors 

op  create 
op  copy 
op  clear 
op  add 
op  remove 
op  union 
op  intersection 
op  difference 

***  accessors 

op  isequal  :  Bag  Bag 

op  extentof  :  Bag 

op  uniqueextentof  :  Bag 

op  iseitpty  :  Bag 

op  isamember  :  Elt  Bag 

op  isasubset  :  Bag  Bag 

op  isapropersubset  :  Bag  Bag 

***  exceptions 

op  overflow  ;  ->  Bag  . 

op  itemisnotinbag  :  ->  Bag  . 

***  variables  declaration 

var  B  B1  B2  :  Bag  . 
var  E  El  :  Elt  . 

***  axioms 

eg  copy(B,Bl)  =  B  . 


->  Bool 
->  Nat  . 
->  Nat  . 
->  Bool 
->  Bool 
->  Bool 
->  Bool 


Bag  Bag  ->  Bag 
Bag  ->  Bag 
Elt  Bag  ->  Bag 
Elt  Bag  ->  Bag 
Bag  Bag  Bag  ->  Bag 
Bag  Bag  Bag  ->  Bag 
Bag  Bag  Bag  ->  Bag 


eg  clear (B)  =  create  . 

eg  remove (E, create)  =  itemisnotinbag  . 
eg  remove (E, add (El, Bl) )  =  if  E  ==  El  then  B1  else 
add(El, remove (E, Bl) )  fi  . 

eg  tmion(B, create, Bl)  «  B  . 

eg  union(B,add(El,Bl) ,B2)  =  add{El,union{B, B1,B2) )  . 
eg  intersection (B, create, Bl)  =  create  . 

eg  intersection(B,add(El,Bl) ,B2)  =  if  isamember (El, B)  then 
add(El,intersection(B,Bl,B2) )  else  intersection(B,Bl,B2)  fi  . 

eg  difference (B, create, Bl)  =  B  . 
eg  difference (create, B,B1)  =  B  . 

eg  difference (B, add (El, Bl) ,B2)  =  if  isamember (El, B)  then 
difference(remove(El,B) ,B1,B2)  else  add{ El, difference {B,B1, B2) )  fi  . 

eg  extentof (create)  =  0  . 

eg  extentof (add (E,B) )  =  1  +  extentof (B)  . 

eg  unigueextent of (create)  =  0  . 

eg  uniqueextentof (add (E,B) )  =  if  isamember (E,B)  then 
uniqueextentof (B)  else  1  +  uniqueextentof (B)  fi  . 

eg  isenpty{B)  =  B  ==  create  . 

eg  isamember (E, create)  =  false  . 

eg  isamember (E, add (El, Bl) )  »  E  ==  El  or  isamember (E,B1)  . 
eg  isasubset  (create,  B)  =;  true  . 

eg  isasubset (add ( E, B) ,B1)  =  if  isamember (E, Bl)  then  isasubset (B,B1) 
else  false  fi  . 

eg  isapropersubset (B,B1)  =  isasubset (B, Bl)  and  extentof (Bl)  > 
extentof (B)  . 

endo 
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BAGS  PROFILE  CODES 


OPERATORS 

SIGNATURES 

PROFILE  CODES 

COPY 

AB->B 

3211 

CLEAR 

A->  A 

2201 

ADD 

AB->B 

3211 

REMOVE 

AB->B 

3211 

UNION 

ABC->C 

4231 

INTERSECTION 

ABC->C 

4231 

DIFFERENCE 

ABC->C 

4231 

IS_EQUAL 

AB->C 

330 

EXTENT_OF 

A->B 

220 

UNI0UE_EXTENT_OF 

A->B 

220 

IS_EMPTY 

A->B 

220 

IS_A_MEMBER 

AB->C 

330 

IS_A_SUBSET 

AB->C 

330 

IS_A_PROPER_SUBSET 

AB->C 

330 

SET  OF  PROFILE:  {4231,321 1,2201,330,220} 
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BAG  SIMPLE  SEQUENTIAL  BOUNDED  MANAGED  ITERATOR 
ADA  SPECIFICATIONS 


obj  BAG [X  : :  TRIV]  is  sort  Bag  . 
protecting  NAT  . 

***  constructors 

op  create 
op  copy 
op  clear 
op  add 
op  remove 
op  union 
op  intersection 
op  difference 

***  accessors 

op  isequal  :  Bag  Bag 

op  extentof  Bag 

op  uniqueextentof  :  Bag 

op  isertpty  :  Bag 

op  isamember  :  Elt  Bag 

op  isasubset  :  Bag  Bag 

op  isapropersubset  :  Bag  Bag 

***  exceptions 

op  overflow  :  ->  Bag  , 

op  i tend  snot inbag  :  ->  Bag  . 

variables  declaration 

var  B  B1  B2  :  Bag  . 
var  E  El  :  Elt  . 

***  axioms 

eq  copy{B,Bl)  =  B  . 


->  Bool  . 
->  Nat  . 
->  Nat  , 
->  Bool  . 
->  Bool  . 
->  Bool  . 
->  Bool  . 


Bag  Bag  ->  Bag 
Bag  ->  Bag 
Elt  Bag  ->  Bag 
Elt  Bag  ->  Bag 
Bag  Bag  Bag  ->  Bag 
Bag  Bag  Bag  ->  Bag 
Baa  Baa  Baa  ->  Bag 


eq  clear (B)  =  create  . 

eq  remove (E, create)  =  itemisnot inbag  . 
eq  remove (E, add (El, Bl) )  =  if  E  ==  El  then  B1  else 
add(El,remove(E,Bl) )  fi  . 

eq  union (B, create, Bl)  =  B  . 

eg  union (B,add(El,Bl) ,B2)  =  add{El,union(B, Bl, B2) )  . 
eq  intersection (B, create, Bl)  =  create  . 

eq  intersection(B,add(El,Bl) ,B2)  =  if  isamember (El, B)  then 
add(El,intersection{B,Bl,B2) )  else  intersection{B,Bl,B2)  fi  . 

eq  difference (B, create, Bl)  =  B  . 
eq  difference (create, B,B1)  =  B  . 

eq  difference (B, add (El, Bl) ,B2)  =  if  isamember { El , B )  then 
dif ference{ remove ( El, B) ,B1,B2)  else  add(El,dif ference (B, Bl, B2) )  fi  . 

eq  extentof (create)  =  0  . 

eq  extentof (add (E,B) )  =  1  +  extentof (B)  . 

eq  xjniqueextentof  (create)  =  0  . 

eq  uniqueextentof  (add(E,B) )  =  if  isamember  (E,B)  then 
uniqueextentof (B)  else  1  +  uniqueextentof (B)  fi  . 

eq  isempty(B)  =  B  ==  create  . 

eq  isamember (E, create)  =  false  . 

eq  isamember  (E,  add  (El,  Bl) )  =  E  ==  El  or  isamember  (E,B1)  . 

eq  isasiibset (create, B)  =  true  . 

eq  isasubset  ( add ( E, B)  ,B1)  =  if  isamember  (E, Bl)  then  isasubset  (B, Bl) 
else  false  fi  . 

eq  isapropersubset (B,B1)  =  isasubset (B, Bl)  and  extentof (Bl)  > 
extentof (B)  . 

endo 
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BAG  SIMPLE  SEQUENTIAL  BOUNDED  MANAGED  ITERATOR 
ADA  IMPLEMENTATION 


—  {C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  sxabject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Con^juter 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

--  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body  Bag_Simple_Sequential_Bounded_Managed_Iterator  is 

procedure  Copy  (FronL_The_Bag  :  in  Bag; 

To_The_Bag  ;  in  out  Bag)  is 

begin 

if  FroitL.The_Bag.The_Back  >  To_The_Bag.The_Size  then 
raise  Overflow; 

else 

To_The_Bag .  The_I  terns  (1  . .  Froni_The_Bag .  The_Back }  :  = 
From_The_Bag .  The_I terns  (1  . .  FrorrL.The„Bag .  The_Back ) ; 
To_The_Bag .  The_Back  :  =  From_The_Bag .  The_Back  ,- 
end  if; 
end  Copy; 

procedure  Clear  (The_Bag  :  in  out  Bag)  is 
begin 

The_Bag.The_Back  :=  0; 
end  Clear ; 


procedure  Add  (The_Item  ;  in  I  tern,- 

To_The_Bag  :  in  out  Bag)  is 

begin 

for  Index  in  1  . .  To_The„Bag . The_Back  loop 

if  The_Item  =  To^The_Bag.The_I terns  (Index)  .The_Item  then 
To_The_Bag . The_I t ems ( Index ) . The_Coun t  : = 

To_The_Bag . The_I t ems ( Index ) . The^Count  +  1 ; 
return; 
end  if; 
end  loop; 

To_The_Bag. The_I terns (To_The_Bag.The_Back  +  1) .Th€_Item  := 
Item; 

To_The_Bag .  The_I  terns  ( To_The_Bag .  The_Back  +  1 )  .  The_,Coun t  :  =  1  ; 
To_The_Bag.ThelBack  :=  To_The_Bag . The_Back  +  1; 
exception 

when  Constraint_Error  => 
raise  Overflow; 

end  Add; 


procedure  Remove  (The_Item  :  in  Item; 

FroituThe^Bag  :  in  out  Bag)  is 

begin 

for  Index  in  1  . .  Frorn_The_Bag .  The_Back  loop 

if  The_Item  ==  FrortL_The_Bag.The_Items (Index)  .The_Item  then 
if  FroiiuThe_Bag.The_Items (Index)  .The_Count  >  1  then 
From_The_Bag . The_I terns { Index ) . The_Count  : = 
From_The_Bag .  The_I  terns  ( Index )  .  The_Coun  t  -  1 ; 

else 

From_The_Bag . The_I terns ( Index  . . 

( Fr om_The_Bag . The^Back  - 

From_The_Bag.The_Items ( (Index  +1) 

Fr om_The_Bag . The_Back ) ; 
FrortL.The_Bag.The_Back  :=  From_The_Bag . The^Back  - 

end  if; 
return ; 
end  if; 
end  loop; 

raise  IteitL.Is_Not_In_Bag; 
end  Remove; 

procedure  Union  (Of_The_Bag  :  in  Bag; 

An(l_The_Bag :  in  Bag; 

To_The_Bag  :  in  out  Bag)  is 

To_Index  :  Natural ; 

To_Back  :  Natural ; 
begin 

To_The_Bag .  The__Items  (1  . .  Of _The_Bag .  The_Back )  :  = 

Of_The_Bag .  The_I terns  (1  . .  Of _The_Bag .  The_Back}  ; 
To_The_Bag.The_Back  :=  Of_The_Bag.The_Back; 

To_Back  :=  To_The_Bag.The_Back; 
for  And_Index  in  1  . .  And_The_Bag . The_Back  loop 
To_Index  :=  To_Back; 
while  To_Index  >  0  loop 

i  f  To_The_Bag .  The_I  terns  ( To_Index )  .  The_I  t em  = 

And_The_Bag. The_I terns (And^Index)  .The_Item  then 
exit; 

else 

To_Index  :=  To_Index  -  1; 
end  if; 
end  loop; 

if  To_Index  =  0  then 

To_The_Bag-The_Iteins  (To_The_Bag.The_Back  +1)  :  = 

And_The_Bag .  The_I  terns  (And_Index} ; 


To_The_Bag.The_Back  :=  To_The_Bag . The_Back  +  1; 

else 

To_The_Bag .  The„I terns  ( To_Index )  .  The_Count  :  = 

To_The_Bag .  The_I  terns  ( To_Index )  .  The^Coun t  + 
And_The_Bag .  The_I  terns  ( AncLIndex )  .  The_Count  ; 
end  if; 
end  loop; 
exception 

when  Constraint_Error  => 
raise  Overflow; 
end  Union; 

procedure  Intersection  (Of_The_Bag  :  in  Bag; 

And_The_Bag  :  in  Bag ; 

To_The_Bag  ;  in  out  Bag)  is 

AncLIndex  :  Natural; 
begin 

To_The_Bag.The_Back  ;=  0; 

for  Of_Index  in  1  . .  Of_The_Bag.The_Back  loop 
And_Index  :=  And_The_Bag.The_Back; 
while  AndL Index  >  0  loop 

if  Of_The_Bag.The_Items(Of_Index)  ,The_Item  = 

And_The_Bag .  The_I  terns  ( Anci_Index )  .  The_I  t em  then 
if  Of_The_Bag.The_Items(Of_Index)  .The_Count  < 

And_The_Bag .  The_I  t  ems  ( And_Index )  .  The^Count  then 
To_The_Bag .  The_I  t  ems  ( To_The_Bag .  The_Back  + 

1) .The_Item 

:=  Of_The_Bag. The_I terns (Of_Index)  .The_Item; 
To_The_Bag .  The_I  terns  ( To_The_Bag .  The_Back  + 

1)  .The_Count 

:  =  0  f _The_Bag .  The_I  terns  { Of _Index )  .  The_Coun t  ; 
To_The_iag.The_Back  :=  To_The_Bag . The_Back  + 

1; 

else 

To_The_Bag .  The_I  terns  ( To_The_Bag .  The_Back  + 

1) .The_Item 

:  =  Of _The_Bag .  The_I terns  ( Of_Index )  .  The_I tem ; 
To_The_Bag .  The_I  terns  ( To_The_B  ag .  The_Back  + 

1)  .The_Count 

And_The  Bag .  The_I  terns  ( And^Index )  .  The_Coun t ; 

To_The_Bag.The_Back  :=  To_The_Bag . The_Back  + 

1; 

end  if; 
exit; 

else 

And^Index  :=  And_Index  -  1; 
end  if; 
end  loop; 
end  loop; 
exception 

when  Constraint_Error  => 
raise  Overflow; 
end  Intersection; 

procedure  Difference  (Of_The_Bag  :  in  Bag; 

And_The_Bag  :  in  Bag; 

To_The_Bag  :  in  out  Bag)  is 

And>.Index  :  Natural; 
begin 

To_The_Bag.The_Back  :=  0; 

for  Of_Index  in  1  . .  Of_The_Bag.The_Back  loop 
And_Index  :=  And_The_Bag . The_Back ; 
while  And_Index  >  0  loop 

i  f  Of _The_Bag .  The_I  terns  ( 0  f _Index )  .  The_I  tem  = 

An(L_The_Bag .  The_I  terns  ( And_Index )  ,  The_I  tem  then 
exit; 

else 

AncLIndex  :=  And_Index  -  1; 
end  if; 
end  loop; 

if  And^Index  =  0  then 

To_The_Bag.The_Items  (To_The_Bag.The_Back  +1}  :  = 

Of_The_Bag  .The_I terns  (Of_Index)  ; 

To_The_Bag .  The_Back  :=  To_The_Bag .  The_Back  +  1; 
els  if  Of_The_Bag.The_Items(Of_Index)  .The_Count  > 

And_The_Bag .  The_I  terns  ( And_Index )  .  The_Count  then 
To_The_Bag .  The_Items  ( To_The_Bag .  The_Back  +  1 )  .  The_I  tem 

0  f _The_Bag .  The_I  terns  ( 0  f  _Index )  .  The_I  t em  ,- 
To_The_Bag .  The_I  terns  ( To_The_Bag .  The_Back  + 

1} .The^Count  := 

Of_The_Bag ,  The_I terns  ( Of_Index )  .  The_Count  - 
And_The_Bag .  The_I  terns  ( And^Index )  .  The_Count ; 
To_The_Bag.The_Back  ;=  To_The_Bag.The_Back  +  1; 
end  if; 
end  loop; 
exception 

when  Constraint_Error  => 
raise  Overflow; 
end  Difference; 

—  modified  by  Tuan  Nguyen  and  Vincent  Hong 

—  date:  8  April  1995 

—  adding  procedures  to  replace  functions 

procedure  Is^Equal  (Left  :  in  Bag; 

Right  :  in  Bag; 
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Result  :  out  Boolean)  is 

begin 

Result  :=  Is_Equal (Left, Right ) ; 
end  Is_Equal; 

procedure  Extent_Of  (The_Bag  :  in  Bag; 

Result  :  out  Natural)  is 

begin 

Result  ;=  Extent_Of (The_Bag) ; 
end  Extent_Of; 

procedure  Unique_Extent_Of  (The_Bag  :  in  Bag; 

Result  ;  out  Natural)  is 

begin 

Result  :=  Unigue_Extent_Of  (The_Bag) ; 
end  Unigue_Extent_Of ; 

procedure  Nuinber_Of  {The_Iteni  :  in  Item; 

In_The_Bag  :  in  Bag; 

Result  :  out  Positive)  is 

begin 

Result  :=  Number_0£{The_Item,In^The_Bag) ; 
end  Number^Of; 

procedure  Is^Ecpty  (The_Bag  :  in  Bag; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is_Ennpty(The_Bag) ; 
end  Is_Einpty; 

procedure  Is^AJIember  (The_Item  ;  in  I tern; 

Of_The_Bag  :  in  Bag; 

Result  :  out  Boolean)  is 

begin 

Result  :  =  Is^AJMeinber  { The_Item,  Of  jrhe_3ag ) ; 
end  Is^jAJlexnber  ; 

procedure  Is_A— Subset  (Left  ;  in  Bag; 

Right  :  in  Bag; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is_A^Subset (Left, Right) ; 
end  Is_A_Sxxbset; 

procedure  Is_A_Proper_S\jbset  (Left  :  in  Bag; 

Right  :  in  Bag; 

Result  :  out  Boolean)  is 

begin 

Result  ;=  Is_^Proper_Subset (Left, Right )  ; 
end  Is_A_Proper_Subset; 

end  of  modification 

fimction  Is_Equal  (Left  :  in  Bag; 

Right  :  in  Bag)  return  Boolean  is 
Right_Index  :  Natural; 
begin 

if  Left.The^Back  /=  Right . The^Back  then 
return  False; 

else 

for  Left_Index  in  1  . .  Lef t .The_Back  loop 
Right_Index  :=  Right  .The_Back; 
while  Right_Index  >  0  loop 

if  Left  .The_I terns  (Lef t_Index)  .The_I tern  = 

Right  .The_„I terns  (Right^Index)  ,The_Item  then 
if  Left. The_I terns (Lef t_Index } . The_Count  / = 

Right,The_Items(Right_Index) .The^Count  then 
return  False; 

else 

exit; 
end  if; 
else' 

Right_Index  ;=  Right_Index  -  1; 
end  if; 
end  loop; 

if  Right_Index  =  0  then 
return  False; 
end  if; 
end  loop; 
return  True; 
end  if; 
end  Is^Equal; 

function  Extent_Of  (The_Bag  :  in  Bag)  return  Natural  is 
Count  :  Natural  ;=  0; 
begin 

for  Index  in  1  . .  The_Bag.The_Back  loop 

Count  :=  Count  +  The_Bag. The_I terns (Index) .The_Count; 
end  loop; 
return  Count; 
end  Extent_Of; 

function  Unique_Extent_Of  (The_Bag  ;  in  Bag)  return  Natural  is 
begin 

return  The_Bag.The_Back; 
end  Unique_Extent_Of ; 

function  N\jmber_Of  (The^Item  :  in  Item; 

In_The_Bag  :  in  Bag)  return  Positive  is 


begin 

for  Index  in  1  . .  In_Th€_Bag . The_Back  loop 

if  The_Item  =  ln_The_Bag. The_I terns  (Index)  .The_I tern  then 
re  turn  In^The  JBag .  The_I  terns  ( Index )  .  The_Coun  t  ; 
end  if; 
end  loop; 

raise  ItenL.Is_^ot_In_Bag; 
end  Number_Of; 

f line t ion  Is_Enpty  (The_Bag  :  in  Bag)  return  Boolean  is 
begin 

return  (The„Bag.The_Back  =0); 
end  Is_Eopty; 

function  Is_A-.Nember  (The^Item  :  in  I  tern; 

Of_The_Bag  :  in  Bag)  return  Boolean  is 

begin 

for  Index  in  1  . .  Of_The_Bag.The_Back  loop 

if  0 f_The_Bag.The_I terns (Index) .The_I tern  =  The^Item  then 
return  True; 
end  if; 
end  loop; 
return  False; 
end  Is^AJIember; 


function  Is_A_Subset  (Left  :  in  Bag; 

Right  :  in  Bag)  return  Boolean  is 
Right_lndex  :  Natural; 
begin 

for  Left_Index  in  1  . .  Left .The_Back  loop 
Right_Index  :=  Right .The_Back; 
while  Right^Index  >  0  loop 

if  Left. The_I terns  ( Le f  t_Index )  .  The_I t em  = 

Right.The_Items (Right_Index) .The_Item  then 
exit; 

else 

Right_Index  ;=  Right_Index  -  1; 
end  if; 
end  loop; 

if  Right_Index  =  0  then 
return  False; 

elsif  Lef t.The_I terns (Lef t_Index) ,The_Count  > 

Right.The_Items(Right_Index) .The_Count  then 
return  False; 
end  if; 
end  loop; 
return  True; 
end  Is^A_Subset; 


function  Is_A_Proper_Subset  (Left  :  in  Bag; 

Right  ;  in  Bag)  return  Boolean  is 
Total_Left_Count  :  Natural  :=  0; 

Total_Right_Count  :  Natural  ;=  0; 

Right_Index  ;  Natural ; 

begin 

for  Left_Index  in  1  . .  Lef t .The_Back  loop 
Right_Index  :=  Right.The_Back; 
while  Right_Index  >  0  loop 

if  Left.The^Items  (Left_Index)  .The_Itera  = 

Right .The_l terns (Right_lndex) .The_Item  then 
exit; 

else 

Right_Index  ;=  Right_Index  -  1; 
end  if; 
end  loop; 

if  Right_Index  =  0  then 
return  False; 

elsif  Left.The_Items(Left_Index) .The_Count  > 

Right . The_I terns ( Righ t^Index ) . The_Count  then 
return  False; 
end  if; 

Total_Left_Co\int  ;=  Total_Left_Coxint  + 

Left .The_I terns (Left_Index) .The^Count 

end  loop; 

for  Index  in  1  . .  Right . The_Back  loop 

Total_Right_Count  :=  Total_Right_Count  + 

Right . The_I terns ( Index) . The_Count ; 

end  loop; 

if  Left .The_Back  <  Right . The_Back  then 
return  True; 

elsif  Left.The_Back  >  Right .The_Back  then 
return  False; 

else 

return  (Total_Left_Count  <  Total_Right„Count) ; 
end  if; 

end  Is^A^Proper_Subset; 


procedure  Iterate  (Over_The_Bag  :  in  Bag)  is 
Continue  :  Boolean; 
begin 

for  The_Iterator  in  1  . -  Over_The_Bag . The_Back  loop 

Process  ( Over^The^Bag .  The_I  terns  ( The_I  t  era  tor )  .  The_I  tern, 
(Jver_The_Bag.The_I terns  (The_Iterator )  .The_Count, 


Continue) ; 

exit  when  not  Continue; 
end  loop; 
end  Iterate; 


end  Bag_SiiJple_Sequential„Bounded_Managed_Iterator ; 
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BAG  SIMPLE  SEQUENTIAL  BOUNDED  MANAGED  ITERATOR 

PSDL 


TYPE  Bag_Siiiiple_Sequential_BoundedJlanaged_I terat or 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TyPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

FronL.The_Bag  :  Bag, 

To_The_Bag  :  Bag 
OUTPUT 

To_The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  Itein_Is_Not_Iiv_Bag 

END 


OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  ItertuIs^ot_In_Bag 

END 

OPERATOR  Extent^Of 
SPECIFICATION 
INPUT 

The^Bag  :  Bag 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Iteiruls_Not_In_Bag 

END 


OPERATOR  Clear 

SPECIFICATION 

INPUT 

The_Bag  :  Bag 
OUTPUT 

The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  Itent_IsJNot_In_Bag 

END 

OPERATOR  Add 

SPECIFICATION 

INPUT 

The_Item  :  Item, 

To_The_Bag  :  Bag 
OUTPUT 

To_The__Bag  :  Bag 
EXCEPTIONS 

Overflow,  Iten\_Is_Not_In_Bag 

END 

OPERATOR  Remove 

SPECIFICATION 

INPUT 

The_Item  :  Item, 

FronL.The_Bag  :  Bag 
OUTPUT 

FronL.The_Bag  ;  Bag 
EXCEPTIONS 

Overflow,  Itern_IsJJot_In_Bag 

END 


OPERATOR  Unigue_Extent_Of 

SPECIFICATION 

INPUT 

The_Bag  :  Bag 
OUTPUT 

Result  ;  Natural 
EXCEPTIONS 

Overflow,  ItenuIs_Not_In_Bag 

END 

OPERATOR  IS_EBipty 

SPECIFICATION 

INPUT 

The_Bag  :  Bag 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Itelr^_Is_Not_In_Bag 

END 

OPERATOR  Is„.RJIeiiiber 

SPECIFICATION 

INPUT 

The_Item  ;  Item, 

Of_The_Bag  :  Bag 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  IteiruIs_Not_In_Bag 

END 


OPERATOR  Union 

SPECIFICATION 

INPUT 

Of_The_Bag  :  Bag, 

And_The_Bag  :  Bag, 

To_The_Bag  ;  Bag 
OUTPUT 

To_The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  IteitL.ls_Not_In_Bag 

END 

OPERATOR  Intersection 

SPECIFICATION 

INPUT 

Of_The_Bag  :  Bag, 

And_The_Bag  :  Bag, 

To_The_Bag  ;  Bag 
OUTPUT 

To_The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  Itein_Is_^ot_In_Bag 

END 

OPERATOR  Difference 

SPECIFICATION 

INPUT 

Of_The_Bag  :  Bag , 

And_The_Bag  :  Bag, 

To_The_Bag  :  Bag 
OUTPUT 

To_The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  Iter[uIs_Not_In„Bag 

END 

OPERATOR  Is_Equal 

SPECIFICATION 

INPUT 

Left  :  Bag, 

Right  :  Bag 


OPERATOR  Is_A_Subset 
SPECIFICATION 
INPUT 

Left  :  Bag, 

Right  :  Bag 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Iten\_Is_Not_In_Bag 

END 

OPERATOR  Is_A_Proper_Subset 
SPECIFICATION 
INPUT 

Left  :  Bag, 

Right  :  Bag 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  ItenuIs^ot_In_Bag 

END 

OPERATOR  Iterate 
SPECIFICATION 

GENERIC  .  ,  ^ 

Process  :  PROCEDURE [The_I tern  :  in[t  :  Item],  The_Count  ;  rn[t 
Positive],  Continue  :  out[t  :  Boolean]] 

INPUT 

Over_The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  Iten\_IsJNot_In^Bag 

END 


END 

KEYWORDS:  BAG 

DESCRIPTIONS:  {Bag,  Simple,  Sequential,  Bounded,  Managed,  Iterator] 

IMPLEMENTATION  ADA  Bag_Siitple_Sequential_Bounded^Managed_Iterator 
END 
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BAG  SIMPLE  SEQUENTIAL  BOUNDED  MANAGED  NONITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

package  Bag_Siinple_SequentialJBoundedLManagedJJoniterator  is 

type  Bag(The_Size  :  Positive)  is  limited  private; 


procedure  Copy  {FroiiuThe_Bag 

To_The_Bag 

procedure  Clear  (The_Bag 

procedure  Add  (The_Itein 

To_The_Bag 

procedure  Remove  {The_Item 

FronuThe_Bag 

procedure  Union  (Of_'Ilie_Bag 

And_The_Bag 
To_The_Bag 

procedure  Intersection  (Of_The_Bag 
And_The_Bag 
To_The_Bag 

procedure  Difference  (Of_TheJBag 
And_The_Bag 
To_TheJBag 


in  Bag; 
in  out  Bag) ; 
in  out  Bag) ; 
in  Item; 
in  out  Bag) ; 
in  Item; 
in  out  Bag) ; 
in  Bag ; 
in  Bag; 
in  out  Bag) ; 
in  Bag; 
in  Bag ; 
in  out  Bag) ; 
in  Bag; 
in  Bag; 
in  out  Bag) ; 


modified  by  Tuan  Nguyen  and  Vincent  Hong 


—  date:  7  April  1995 

—  adding  procedures  to  replace  functions 


procedure  Is_Equal 

procedure  Extent_Of 
procedure  Unique_Extent_Of 
procedure  ls_Errpty 
procedure  Is_Aw_Neinber 

procedure  Is^A^Subset 


{Left  :  in  Bag; 

Right  ;  in  Bag; 

Result  :  out  Boolean) ; 

(The_Bag  :  in  Bag; 

Result  :  out  Natural )  ; 

(The^Bag  :  in  Bag; 

Result  :  out  Natural ) ; 

(The_Bag  :  in  Bag; 

Result  :  out  Boolean) ; 

(The_Item  :  in  Item; 

Of_The_Bag  :  in  Bag; 

Result  :  out  Boolean) ; 

(Left  :  in  Bag; 


Right  :  in  Bag; 

Result  ;  out  Boolean) ; 

procedure  Is_A^Proper_Subset  (Left  :  in  Bag; 

Right  :  in  Bag; 

Result  :  out  Boolean) ; 

—  end  of  modification 

function  Is_Equal  (Left 

Right 

function  Extent_Of  (The_Bag 

function  Unique_Extent_Of  (The_Bag 
function  Number_Of  (The_Item 

In^The_Bag 

Positive; 

function  Is_Enpty  (The_Bag 

f unc  t  ion  Is_AJlen03er  ( The_I  t em 

Of_The_Bag 

function  Is_A-Subset  (Left 

Right 

f unc  t  ion  Is_A_Proper_Subse  t  (Left 
Right 

Overflow  :  exception; 

Item_Is_Not_In_Bag  :  exception; 

private 

type  Node  is 
record 

The^Item  I  tern; 

The^Coxmt  :  Positive; 
end  record; 

type  Items  is  array (Positive  range  <>)  of  Node; 
type  Bag(The_Size  :  Positive)  is 
record 

The_Back  :  Natural  :=  0; 

The_Items  :  Items (1  ..  The^Size) ; 
end  record; 

end  Bag_Simple_Seguential_BoundedJManagedJIoniterator ; 


:  in  Bag ; 

;  in  Bag)  return  Boolean; 
:  in  Bag)  return  Natural; 
:  in  Bag)  return  Natural; 
:  in  Item; 

:  in  Bag)  return 

:  in  Bag)  return  Boolean; 
;  in  Item; 

:  in  Bag)  return  Boolean; 
:  in  Bag ; 

:  in  Bag)  return  Boolean; 
;  in  Bag ; 

:  in  Bag)  return  Boolean; 
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BAG  SIMPLE  SEQUENTIAL  BOUNDED  MANAGED  NONITERATOR 

ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Ntumber  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Computer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood. 

—  Colorado  80227  (1-303-987-1874) 

package  body  Bag_Sinple_Sequential_Boxmded_Managed_Moniterator  is 

procedure  Copy  (FronL.The_Bag  :  in  Bag; 

To_The_Bag  ;  in  out  Bag)  is 

begin 

if  Fro:tuThe_Bag.The_Back  >  To_The„Bag.The_Size  then 
raise  Overflow; 

else 

To_The_Bag .  The_I  terns  (1  . .  FrortuThe_Bag .  The^Back )  :  = 
FronL.The_Bag .  The_I terns  (1  . .  Froii:uThe_Bag .  The_Back)  ; 
To_The_Bag .  The_Back  ;  =  Fr oituThe.Bag .  The_Bac  k  ; 
end  if; 
end  Copy; 

procedure  Clear  (The_Bag  :  in  out  Bag)  is 
begin 

The_Bag.The_Back  :=  0; 
end  Clear; 


procedure  Add  (The^Item  ;  in  Item; 

To_The_Bag  :  in  out  Bag)  is 

begin 

for  Index  in  1  . .  To_The_Bag . The^Back  loop 

if  The_Item  =  To_The_Bag-The_I terns  (Index)  .The_Item  then 
To_The_Bag .  The_I  terns  ( Index )  .  The_Coun t  :  = 

To_The_Bag .  The^Items  ( Index )  .  The_Covint  +  1  ; 
return; 
end  if; 
end  loop; 

To_The_Bag . The_I terns ( To_The_Bag . The_Back  +  1 ) . The_I tern  : = 
The_Item; 

To_The_Bag.The_Items(To_The_Bag.The_Back  +  1) .The_Count  :=  1; 
To_The_Bag.The_Back  :=  To_The_Bag . The_Back  +  1; 
exception 

when  Constraint_Error  => 
raise  Overflow; 

end  Add; 


D) 


1; 


procedure  Remove  (The_Item  :  in  Item; 

From_The_Bag  :  in  out  Bag)  is 

begin 

for  Index  in  1  . .  FronuThe_Bag . The_Back  loop 

if  The_Item  =  Fr onuThe_Bag.The_I terns (Index) .The_I tern  then 
if  FronL_The_Bag.The_Iteins (Index)  .The_Count  >  1  then 
From_The_Bag .  The_I  terns  ( Index )  .  The_Coun t  :  = 

Fr om_The_Bag . The_I terns ( Index ) . The_Coun t  -  1 ; 

else 

From_The_Bag .  The_I  terns  ( Index  . . 

(From_The_Bag.The_Back  - 

FroitL.The_Bag-The_Items(  (Index  +  1)  .. 

From_The_Bag.The_Back) ; 
From_The_Bag.The_Back  :=  FronuThe_Bag . The_Back  - 

end  if; 
return; 
end  if; 
end  loop; 

raise  1 1 eitL.ls_No t_In_Bag  ; 
end  Remove; 


procedure  Union  (Of_The_Bag  : 

And_The_Bag : 
To_The_Bag  : 
Natural; 
Natural ; 


in  Bag; 

in  Bag; 

in  out  Bag) 

To^Index 
To_Back 
begin 

To_The„Bag . The_I terns ( 1 
Of_The_Bag .  The_I  terns  ( 1 
To_The_Bag.The_Back  :=  Of_The_Bag.The_Back; 

To_Back  :=  To_The_Bag .The_Back; 
for  And_Index  in  1  . .  And_The_Bag . The^Back  loop 
To_Index  :=  To_Back; 
while  To_Index  >  0  loop 

i  f  To_The_Bag .  The_I  terns  ( To_Index )  .  The_I  t em  = 

And_The_Bag .  The_Items  (And_Index)  . The_I tern  then 
exit; 


Of _The_Bag . The_Back )  : = 

Of_The_Bag . The_Back ) ; 


else 

To^Index  :=  To_Index  -  1; 
end  if; 
end  loop; 

if  To_Index  =  0  then 

To_The_Bag.The_Items (To_The_Bag.The_Back  +1)  := 

And_The_Bag.The_I terns  (And_Index)  ; 


To_The_Bag . The_Back  :=  To_The_Bag . The_Back  +  1; 

else 

To_The_Bag . The_I t ems { To^Index ) . The_Count  ; = 
To_The_Bag.The_Items (To_Index) .The_Count  + 
And_The_Bag . The_I terns (And^Index) . The^Count ; 
end  if; 
end  loop; 
exception 

when  Constraint_Error  -> 
raise  Overflow; 
end  Union; 


procedure  Intersection  (Of_The_Bag  :  in  Bag; 

And_The_Bag  :  in  Bag; 

To_The_Bag  ;  in  out  Bag)  is 

AndLIndex  ;  Natural; 
begin 

To_The_Bag.The_Back  :=  0; 

for  Of_Index  in  1  . .  Of_The_Bag.The_Back  loop 
AndLIndex  :=  An(i_The_Bag.The_Back; 
while  And_lndex  >  0  loop 

if  Of  The_Bag.The_Items{Of_Index) .The_Item  = 

And_The_Bag .  The_I  terns  ( AncLIndex )  .  The_I  tern  then 
if  Of_The__Bag.The_Items{Of_Index)  .The^Count  < 

And>.The_Bag.The_I terns  (AndLIndex)  .The_Count  then 
To_The_Bag .  The_I  terns  ( To_The_Bag .  The_Back  + 


1) .The_Item 


:  =  Of_The_Bag . The„Items  { Of_Index)  . The_I tern; 
To_The_Bag .  The_I  terns  ( To_The_Bag .  The_Back  + 


1) .The_Count 


:=s  Of_The_Bag.The_Items(Of„Index)  .The^Count; 
To_The_Bag.The_Back  :=  To_The_Bag . The_Back  + 


1; 

1) .The^Item 
1) .The_Count 


else 

To_The_Bag . The_I terns ( To_The_Bag . The_Bac k  + 

:  =  Of_The_Bag .  The_Items  (Of^Index)  . The_Item; 
To_The_Bag .  The_I  terns  ( To_The_Bag .  The_Back  + 


And_The_Bag.The_I terns  (And_Index)  .The_Count; 

To_The_Bag.The_Back  :=  To_The_Bag . The_Back  + 

1; 

end  if; 
exit; 

else 

And_Index  :s:  AndLIndex  -  1; 
end  if; 
end  loop; 
end  loop; 
exception 

when  Constraint_Error  => 
raise  Overflow; 
end  Intersection; 


procedure  Difference  (Of_The_Bag  :  in  Bag; 

AndLThe_Bag  :  in  Bag; 

To_The_Bag  :  in  out  Bag)  is 

And_Index  :  Natural; 
begin 

To_The_Bag .  The__Back  :  =  0 ; 

for  Of_Index  in  1  . .  Of_The_Bag . The_Back  loop 
And_Index  :=  And_The_Bag - The_Back ; 
while  AndLIndex  >  0  loop 

if  Of_The_Bag.The_Items{Of_Index) .The_Item  = 

And_The_Bag .  The_I  terns  ( And_lndex )  .  The_I  t  em  then 
exit; 

else 

And_lndex  :=  AncLIndex  -  1; 
end  if; 
end  loop; 

if  AndLIndex  =  0  then 

To_The_Bag.The_Items(To_The_Bag.The_Back  +1)  := 

Of_The_Bag.The_I terns (Of_Index) ; 

To_The_Bag . The_Back  :=  To_The_Bag . The_Back  +  1; 
elsif  Of_The_Bag.The_Items (Of_Index) .The_Count  > 

And_The_Bag .  The_I  terns  ( And_Index )  .  The_Coun t  then 
To_The_Bag .  The_I terns  ( To_The_Bag .  The_Back  +  1 )  .  The_I  tern 


0  f _Th€_Bag .  The_I  terns  { 0  f _Index )  .  The_I  tern  ; 
To_The  JBag .  The_I  terns  ( To_The_Bag .  The_Back  + 

['he_Count  :  = 

Of_The_Bag.The_Items{Of_Index)  .The_Count  - 
And_The_Bag  .The_I  terns  (And_Index)  .  The_Count ; 
To_The_Bag.The_Back  :=  To_The_Bag . The_Back  +  1; 
end  if; 
end  loop; 
exception 

when  Constraint_Error  => 
raise  Overflow; 
end  Difference; 


—  modified  by  Tuan  Nguyen  and  Vincent  Hong 

—  date;  8  April  1995 

adding  procedures  to  replace  functions 


procedure  Is_Equal  (Left 
Right 


in  Bag; 
in  Bag; 
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Result  ;  out  Boolean)  is 

begin 

Result  :=  is^Equal (Left, Right ) ; 
end  Is_Equal ; 

procedure  Extent_Of  (The_Bag  :  in  Bag; 

Result  :  out  Natural)  is 

begin 

Result  :=  Extent^Of (The_Bag) ; 
end  Extent_Of ; 

procedure  Unique_Extent_Of  {The_Bag  :  in  Bag; 

Result  :  out  Natural)  is 

begin 

Result  :=  Unique_Extent_Of  (The_Bag) ; 
end  Unique_Ext€nt„Of ; 

procedure  Nuinber^Of  (The_Item  :  in  Item; 

In_The_Bag  :  in  Bag; 

Result  :  out  Positive)  is 

begin 

Result  :  =  Nuinber_0 f  ( The_I t em ,  ln„The_Bag )  ; 
end  Nuinber_Of; 

procedure  Is_Enpty  {The_Bag  :  in  Bag; 

Result  :  out  Boolean)  is 

Isegin 

Result  : =  Is_Emp ty ( The_Bag ) ; 
end  Is_Eii:pty; 

procedure  Is_AJleiiib€r  {The_Item  :  in  Item; 

Of_The_Bag  :  in  Bag; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is^JMember{The_Item,Of_The_Bag) ; 
end  Is^A^ember  ; 

procedure  Is_jA_Siibset  (Left  :  in  Bag; 

Right  :  in  Bag; 

Result  :  out  Boolean)  is 

begin 

Result  ls_Av„Subset(Left, Right)  ; 
end  Is_A_Subset; 

procedure  Is_A^Proper_S\jbset  (Left  :  in  Bag; 

Right  :  in  Bag; 

Result  :  out  Boolean)  is 

begin 

Result  :  =  Is_J\^Proper_Subset  ( Lef  t ,  Right )  ; 
end  Is_A-,Proper_Sxibset; 

end  of  modification 

f\mction  Is_Equal  (Left  :  in  Bag; 

Right  :  in  Bag)  return  Boolean  is 
Right_Index  :  Natural; 
begin 

if  Left.The_Back  /=  Right . The_Back  then 
return  False; 

else 

for  Left_Index  in  1  . ,  Lef t .The_Back  loop 
Kight_Index  :=  Right .The_Back; 
while  Right_Index  >  0  loop 

if  Left.The_Items (Left_Index) .The_Item  = 

Right . The_I terns ( Righ t^Index ) . The_I tern  then 
if  Left. The_I terns  ( Le f  t_Index )  . The_Count  / = 

Right .  The_I  terns  ( Righ t_Index )  ,  The_Count  then 
return  False; 

else 

exit; 
end  if; 

else 

Right_Index  ;=  Right_Index  -  1; 
end  if; 
end  loop; 

if  Right_Index  =  0  then 
return  False; 
end  if; 
end  loop; 
return  True; 
end  if; 
end  Is_Egual; 

function  Extent_Of  (The^Bag  :  in  Bag)  return  Natural  is 
Co\int  ;  Natural  :=  0; 
begin 

for  Index  in  1  . .  The_Bag . The_Back  loop 

Count  :=  Count  +  The_Bag. The_I terns  (Index)  .The_Count; 
end  loop; 
return  Coxmt; 
end  Extent_Of; 

function  Unique_Extent_Of  (The_Bag  :  in  Bag)  return  Natural  is 
begin 


return  The_Bag.The_Back; 
end  Unique_Extent_Of ; 

function  Number_Of  (The_Item  :  in  Item; 

In_The_Bag  ;  in  Bag)  return  Positive  is 

begin 

for  Index  in  1  . .  In_The^Bag.The_Back  loop 

if  The_Item  =  In_The_Bag. The_I terns (Index) .The_I tern  then 
re  turn  In_The_Bag .  The_I  terns  ( Index )  .  The_Coun  t ; 
end  if; 
end  loop; 

raise  Item_Is_Not_In_Bag ; 
end  Niunber_Of; 

fxinction  Is_Enpty  (The_Bag  :  in  Bag)  return  Boolean  is 
begin 

return  {The_Bag.The_Back  =  0); 
end  Is_Empty; 

function  Is.J^ember  (The_Item  ;  in  I  tern; 

Of_The_Bag  :  in  Bag)  return  Boolean  is 

begin 

for  Index  in  1  .  .  Of _The_Bag .  The_Back  loop 

if  Of_The_Bag.The_Items (Index)  .The_I tern  =  The^Item  then 
return  True; 
end  if; 
end  loop ; 
return  False; 
end  is^A^ember; 

function  Is_A-Subset  (Left  :  in  Bag; 

Right  :  in  Bag)  return  Boolean  is 
Right_Index  ;  Natural; 
begin 

for  Left_Index  in  1  . ,  Left .The_Back  loop 
Right_Index  :=  Right .The^Back; 
while  Right_Index  >  0  loop 

if  Left  .The_Iteins( Lef t_Index)  .The_Item  = 

Righ t,The_I terns { Righ t_Index) .The_Item  then 
exit; 

else 

Right_Index  ;=  Right_Index  -  1; 
end  if; 
end  loop; 

if  Right_Index  =  0  then 
return  False; 

e  Is  i  f  Left.  The_I  terns  ( Le  f  t_Index )  .  The_Coxin t  > 

Right. The_I t ems (Right_Index) .The_Count  then 
return  False; 
end  if; 
end  loop; 
return  True; 
end  Is^_Subset; 

fxinction  Is^_Proper_Subset  (Left  :  in  Bag; 

Right  :  in  Bag)  return  Boolean  is 
Total_Left_Count  :  Natural  :=  0; 

Total_Right_Count  :  Natural  :=  0; 

Right_Index  ;  Natural ; 

begin 

for  Left_Index  in  1  . .  Left .The^Back  loop 
Right_Index  Right .The_Back; 
while  Right_Index  >  0  loop 

if  Left  .The_I terns  (Lef t_lndex)  .The_I tern  = 

Right .  The_I  terns  ( Righ t_Index )  .  The_I  tern  then 
exit; 

else 

Right_Index  ;=  Right_Index  -  1; 
end  if; 
end  loop; 

if  Right_Index  *=  0  then 
return  False ; 

elsif  Left.The_Items(Left_Index) .The^Count  > 

Righ t.The^It ems ( Righ t^Index)  .The_Count  then 
return  False; 
end  if; 

Total„Left_Count  :=  Total_Left_Count  + 

Lef  t.The^l terns  {Left_Index)  .The^Count; 

end  loop; 

for  Index  in  1  . .  Right , The_Back  loop 

Total_Right_Count  ;=  Total_Right_Count  + 

Right. The_I terns (Index) .The_Count; 

end  loop; 

if  Left-The_Back  <  Right.The_Back  then 
return  True; 

elsif  Left.The_Back  >  Right . The_Back  then 
return  False; 

else 

return  (Total_Lef  t_Coiant  <  Total_Right_Count)  ; 
end  if; 

end  Is^A^Proper_Subset; 

end  Bag_Siiiple_Sequent  ial_Bo\indedJManaged_Noni terator ; 
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BAG  SIMPLE  SEQUENTIAL  BOUNDED  MANAGED  NONITERATOR 

PSDL 


TYPE  Bag_Sin5Jle_Sequeiitial_Bounded_ManagecLJIoniterator 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

FroiTL_The_Bag  :  Bag, 

To_The_Bag  :  Bag 
OUTPUT 

To_The_Bag  ;  Bag 
EXCEPTIONS 

Overflow,  Item_Is_Not_In_Bag 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Bag  :  Bag 
OUTPUT 

The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  Iteit\_Is_Not_In_Bag 

END 

OPERATOR  Add 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

To_The„Bag  :  Bag 
OUTPUT 

To_The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  Item_Is_Not_In_Bag 

END 

OPERATOR  Remove 
SPECIFICATION 
INPUT 

The^Item  :  Item, 

FronuThe_Bag  :  Bag 
OUTPUT 

From_The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  Itein_Is_Not_In_Bag 

END 

OPERATOR  Union 
SPECIFICATION 
INPUT 

Of_The_Bag  :  Bag, 

And_The_Bag  :  Bag, 

To_The_Bag  :  Bag 
OUTPUT 

To_The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  Item_Is_Not_In_Bag 

END 

OPERATOR  Intersection 
SPECIFICATION 
INPUT 

Of_The_Bag  :  Bag, 

And_The_Bag  :  Bag, 

To__The_Bag  :  Bag 
OUTPUT 

To_The_Bag  ;  Bag 
EXCEPTIONS 

Overflow,  IteituIs^ot_In_Bag 

END 

OPERATOR  Difference 
SPECIFICATION 
INPUT 

Of_The_Bag  :  Bag , 

And__The_Bag  :  Bag , 

To_The_Bag  :  Bag 
OUTPUT 

To_The_Bag  :  Bag 
EXCEPTIONS 


Overflow,  ItenuIs_Not_In^Bag 

END 

OPERATOR  Is^Equal 
SPECIFICATION 
INPUT 

Left  ;  Bag, 

Right  :  Bag 
OUTPUT 

Result  ;  Boolean 
EXCEPTIONS 

Overflow,  ItenL.Is_Not_In_Bag 

END 

OPERATOR  Extent_Of 
SPECIFICATION 
INPUT 

The_Bag  ;  Bag 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  ItenuIs_Not_In_Bag 

END 

OPERATOR  Unique_Extent_Of 
SPECIFICATION 
INPUT 

The_Bag  :  Bag 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Iten\_Is_Not_In_Bag 

END 

OPERATOR  Is^Empty 
SPECIFICATION 
INPUT 

The_Bag  :  Bag 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Iten\_Is_Not_In_Bag 

END 

OPERATOR  Is_AJMember 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

Of_The_Bag  :  Bag 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Item_IsJJot_In_Bag 

END 

OPERATOR  Is^A^Subset 
SPECIFICATION 
INPUT 

Left  :  Bag, 

Right  :  Bag 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Item_Is_Not_In_Bag 

END 

OPERATOR  Is_A_Proper_Subset 
SPECIFICATION 
INPUT 

Left  :  Bag, 

Right  :  Bag 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Item_Is_Not_In_Bag 

END 

END 

IMPLEMENTATION  ADA  Bag_Siinple_Sequential_Bounded_Managed_Noniterator 

END 
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BAG  SIMPLE  SEQUENTIAL  UNBOUNDED  MANAGED  ITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

package  Bag_Siii5ile_Seguential_Unl)OundedLJlanaged_Iterator  is 


type  Bag  is  limited  private; 


procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 


Copy 

Clear 
Add 

Remove 

Union 

Intersection 

Difference 


( FronuThe_Bag 
To_The_Bag 
(The_Bag 
(The_Item 
To_The_Bag 
('rhe_Item 
Froii\_The_Bag 
{Of_The_Bag 
And_The_Bag 
To_The_Bag 
(Of_The_Bag 
And_The_Bag 
To_The_Bag 
(Of_The_Bag 
Andjrhe_Bag 
To_The_Bag 


:  in  Bag ; 

;  in  out  Bag) ; 
:  in  out  Bag) ; 
:  in  Item; 
:  in  out  Bag) ; 
:  in  Item; 
:  in  out  Bag)  ; 
in  Bag; 

:  in  Bag; 

:  in  out  Bag) ; 
:  in  Bag; 

:  in  Bag  ; 

:  in  out  Bag) ; 
;  in  Bag; 

:  in  Bag  ; 

:  in  out  Bag) ; 


—  modified  by  Tuan  Nguyen  and  Vincent  Hong 

—  date:  7  April  1995 

—  adding  procedures  to  replace  functions 


procedure  Is_Equal 


procedure  Extent^Of 
procedure  Uni<3ue_Extent_0f 
procedure  Is_En5>ty 
procedure  Is^AJIember 


(Left 

Right 

Result 

(The_Bag 

Result 

(The_Bag 

Result 

{The_Bag 

Result 

{The_Item 

Of_The_Bag 


in  Bag; 
in  Bag; 
out  Boolean) ; 
in  Bag; 
out  Natural ) ; 
in  Bag; 
out  Natural); 
in  Bag; 
out  Boolean) ; 
in  I tern; 
in  Bag; 


Result 

:  out  Boolean) ; 

procedure  Is_^_Subset 

{Left 

:  in  Bag ; 

Right 

:  in  Bag; 

Result 

;  out  Boolean) ; 

procedure  Is_A_Proper_Subset  (Left 

;  in  Bag ; 

Right 

:  in  Bag ; 

Result 

;  out  Boolean) ; 

end  of  modification 

fxinction 

Is_Equal 

(Left 

:  in  Bag ; 

Boolean 

Right 

:  in  Bag) 

return 

fxinction 

Extent_Of 

(TheJBag 

:  in  Bag) 

return 

Natural 

function 

Unique«.Extent_Of 

(The  Bag 

:  in  Bag ) 

return  Natural 

f\inction 

Number_Of 

(The_Item 

:  in  Item; 

In_The_Bag 

:  in  Bag) 

return 

Ltive ; 

Boolean 

function 

Is_En?3ty 

(The_Bag 

:  in  Bag) 

return 

function 

Is_A^Member 

(The_Item 

:  in  I  tern; 

Of_The_Bag 

:  in  Bag) 

return 

Boolean 

function 

Is^A^Subset 

(Left 

:  in  Bag ; 

Right 

:  in  Bag) 

return 

Boolean 

function 

Is^A^Proper_StJbset 

(Left 

:  in  Bag ; 

Right 

:  in  Bag) 

return  Boolean 

generic 

in  Item; 

with 

procedure  Process 

(The^Item  : 

The_Count  :  in  Positive; 
Continue  :  out  Boolean) ; 
procedure  Iterate  (Over„The_Bag  :  in  Bag) ; 

Overflow  :  exception; 

ItertL.Is_Not_In_Bag  :  exception; 

private 

type  Node; 

type  Bag  is  access  Node; 

end  Bag_Sin:?5le_Seguential_Unbounded^anaged_Iterator ; 
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BAG  SIMPLE  SEQUENTIAL  UNBOUNDED  MANAGED  ITERATOR 

ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 
--  All  Rights  Reserved 

—  Serial  Niimber  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Conputer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S,  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

with  Storage_JIanager_Sequential; 

package  body  Bag_Siinple_Seguential_Unboundec3LManaged.Iterator  is 

type  Node  is 
record 

The^Item 
The_Count 
Next 

end  record; 

procedure  Free  (TheJJode  :  in  out  Node)  is 
begin 

The_Node . The_Count  : =  1 ; 
end  Free; 

procedure  Set^Next  {The_Node  :  in  out  Node; 

To_Next  :  in  Bag)  is 

begin 

The_Node . Next  : =  To_Next ; 
end  Set_Next; 

function  Next^Of  (The_Node  :  in  Node)  return  Bag  is 
begin 

return  The_^ode  .Next  ; 
end  Next_Of; 

package  Node_Manager  is  new  storage_Manager_Sequential 

(Item  =>  Node, 

Pointer  =>  Bag, 

Free  =>  Free, 

Set_Pointer  =>  Set^ext, 
Pointer_Of  =>  Next_Of ) ; 

procedure  Copy  (Froin_The_Bag  :  in  Bag; 

To__The_Bag  :  in  out  Bag)  is 

Froin_Index  :  Bag  :=  FrortuThe_Bag; 

To^Index  :  Bag; 
begin 

Node JManager .  Free  ( To_The_Bag )  ; 
if  FroiiL_The_Bag  /=  null  then 

To_The_Bag  ;=  Node_Jlanager  ,New_ltem; 
To_The_Bag.The_Item  :=  Fron\_Index.The_Itein; 
ToZThe_Bag .  The_Coun  t  :  =  Fr on\_Index .  The_Coun t  ; 
To_lndex  :=  To_The_Bag; 

Froiruindex  ;=  From_Index.Next; 
while  Fronuindex  /=  null  loop 

To^Index.Next  :=  Node_Manager .New_Item; 

To_Index  :=  To„Index . Next ; 

To^Index . The_Item  :=  FronL.lndex.The_Itein; 
To_Index.The_Coxjnt  :=  Froituindex . The_Count ; 
Fronuindex  :=  FroituIndex.Next ; 
end  loop; 
end  if; 
exception 

when  Storage^Error  => 
raise  Overflow; 
end  Copy; 

procedure  Clear  <The_Bag  :  in  out  Bag)  is 
begin 

Node_Manager . Free ( The_Bag ) ; 
end  Clear; 

procedure  Add  (The^Item  :  in  Item; 

To_The_Bag  :  in  out  Bag)  is 
Teaporary^Node  :  Bag ; 

Index  :  Bag  :=  To_The_Bag; 

begin 

while  Index  f-  null  loop 

if  Index. The_I tern  =  The^Item  then 

Index. The^Count  :=  Index. The_Count  +  1; 
return; 

else 

Index  ;=  Index. Next; 
end  if; 
end  loop; 

Tenporary^ode  :=  Node__Manager  .New_Item; 

Tenporary_Node  .The_Item  :=  The^Item; 

Teirporary_Node  -  The_Coiint  ;  =  1; 

Teitporary^ode  .Next  :=  To_The_Bag; 

To_The_Bag  :=  Tenporary_Node ; 
exception 

when  Storage_Error  => 
raise  Overflow; 


Item; 
Positive ; 
Bag; 


end  Add; 

procedure  Remove  (The_Item  :  in  I  tern; 

From_The_Bag  :  in  out  Bag)  is 
Previous  :  Bag; 

Index  :  Bag  :=  From_The_Bag ; 
begin 

while  Index  /=  null  loop 

if  Index. The_I tern  =  The_Item  then 
if  Index. The_Count  >  1  then 

Index. The_Count  :=  Index . The_Co\jnt  -  1; 
els if  Previous  =  null  then 

FroituThe_Bag  :=  FrortuThe_Bag.Next; 

Index . Next  : =  null ; 

Node_Manager . Free ( Index) ; 

else 

Previous .Next  :=  Index. Next ; 

Index. Next  :=  null; 

NodeJMcuiager .  Free  ( Index) ; 
end  if; 
return; 

else 

Previous  :=  Index; 

Index  Index. Next ; 
end  if; 
end  loop; 

raise  ItenuIs_Not_In_Bag; 
end  Remove; 


procedure  Union  (Of_The_Bag  :  in  Bag; 

And_The_Bag:  in  Bag; 

To_The_Bag  :  in  out  Bag)  is 

From_Index  :  Bag  ;=  Of_The_Bag; 

To_Index  :  Bag ; 

To_Top  :  Bag; 

Tenporary^Node  :  Bag; 

begin 

Node ^Manager . Free ( To_The_Bag ) ; 
while  From_Index  /=  null  loop 

Teitporary_Node  ;=  Nodejlainager  .New_Item; 

Tenporary JJode . The_ltem  :=  From_Index.The_Item; 
Teitporary_Node .  The_Count  :  =  Froii\_Index .  The__Count ; 
Tenporary_Node.Next  :=  To_The_Bag; 

To_The_Bag  :=  Tenporary_Node ; 

From_.Index  :=  From_Index.Next; 
end  loop; 

FroitL-Index  :=  An(i_The_Bag ; 

To_Top  : =  To_The_Bag ; 
while  From_Index  i-  null  loop 
To_Index  : =  To_Top ; 
while  To_Index  /=  null  loop 

if  From_Index,The_Item  =  To_Index.The_Item  then 
exit; 

else 

To_Index  :=  To_Index.Next ; 
end  if; 
end  loop; 

if  To_Index  =  null  then 

Tenporary_Node  :=  Node_Manager  .New_Item; 

Teirpor ary_Node .  The_I  t em  :  =  Fr om_Index .  The_l  t em ; 
Tenpor ary_Node .  The_Count  :  =  Fr om_lndex .  The^Coiint ; 
Teirpor ary_^ode. Next  ;=  To_The_Bag; 

To«.The_Bag  :  =  Tenporary^ode  ; 

else 

To_Index.The_Count 

To_Index .  The_Count  +  From_Index.The_Count ; 
end  if; 

From_Index  :=  FronuIndex.Next ; 
end  loop; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Union; 


procedure  Intersection  {Of_The_Bag  :  in  Bag; 

And_The_Bag  :  in  Bag; 

To_The_Bag  :  in  out  Bag)  is 

Of_Index  ;  Bag  :=  Of_The_Bag; 

And_Index  :  Bag; 

Tenpor ary_JJode  :  Bag ; 
begin 

NodeJManager . Free ( To_The_Bag ) ; 
while  Of_Index  /-  null  loop 
And_Index  :  =  And^The_Bag ; 
while  And^Index  /=  null  loop 

if  Of_Index.The_Item  =  And_Index.The_Item  then 
TettporaryJNode  NodeJManager  .New_Item; 
Teicporary_Node ,  The_I  t em  : «  of _Index .  The__I  tern ; 
if  Of_Index.The_Count  <  And^Index . The_Count  then 
Teitpor aryJJode .  The_Count  :  = 

Of _Index . The_Count ; 

else 

Teirporary_Node .  The^Count  :  = 


And_Index ,  The_Count  ; 

end  if; 

Tenpor ary_Node. Next  :=  To_The_Bag; 
To_The_Bag  :  =  TeitporaryJMode ; 
exit; 
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else 

AndLIndex  :=  And_Index.Next; 
end  i£; 
end  loop; 

Of_Index  ;=  0 f .Index. Next ; 
end  loop; 
exception 

when  Storage.Error  => 
raise  Overflow; 
end  Intersection; 

procedure  Difference  {Of.The_Bag  :  in  Bag; 

And.The_Bag  ;  in  Bag; 

To.The.Bag  ;  in  out  Bag)  is 

Of .Index  :  Bag  :=  Of.The.Bag; 

AndLIndex  ;  Bag; 

TeitporaryJJode  ;  Bag; 

begin 

Node_^anager ,  Free  (To.^e.Bag) ; 
while  Of .Index  /=  null  loop 
AncLIndex  :=  And.The.Bag; 
while  AndLIndex  /=  null  loop 

if  Of  .Index.  The.I  tern  =  And.Index.The.Item  then 
exit; 

else 

And.lndex  :=  And_Index.Next ; 
end  if; 
end  loop; 

if  AncLIndex  =  null  then 

TeJtqporary_Node  ;=  Node.flanager  .New_Item; 
Tenporary^Node.  The.I  tern  :=  Of  .Index.  The.I  tern; 
Ten5)orary_Node.The.Count  :=  0 f. Index. The.Coun t ; 
Teit^orary__Node.Next  :=  To.The_Bag; 

To.The.Bag  :=  Temporaryi^Iode  ; 
elsif  Of  .Index.  The.Count  >  And_Index.The_Co\ant  then 
Teiiporary.Node  :=  NodeJManager  .New_ltein; 
Teirporcory JJode .  The.Item  :  =  Of. Index .  The.I  tern; 
Texrporary jjode . The.Coxjunt  :=  Of. Index. The.Count  - 
And.Index .  The_Co\jnt  ; 
Tei!iporary_j!Jode  .Next  :=  To.The.Bag; 

To.The.Bag  :=  Ten5)orary_JJode ; 
end  if; 

Of. Index  :=  Of. Index. Next; 
end  loop; 
exception 

when  Storage.Error  => 
raise  Overflow; 
end  Difference; 

modified  by  Tuan  Nguyen  and  Vincent  Hong 
date:  8  April  1995 

adding  procedures  to  replace  functions 

procedure  Is.Equal  (Left  :  in  Bag; 

Right  ;  in  Bag; 

Result  :  out  Boolean)  is 

begin 

Result  : =  Is.Equal (Lef t , Right ) ; 
end  Is.Equal; 

procedure  Extent.Of  (The.Bag  :  in  Bag; 

Result  :  out  Natural)  is 

begin 

Result  :=  Extent.Of (The.Bag) ; 
end  Extent.Of; 

procedure  Unique.Extent.Of  (The.Bag  :  in  Bag; 

Result  :  out  Natiiral)  is 

begin 

Result  :=  Unique.Extent.Of  (The.Bag) ; 
end  Unique.Extent.Of; 

procedure  Nvunber.Of  (The.Item  :  in  Item; 

In.The.Bag  :  in  Bag; 

Result  ;  out  Positive)  is 

begin 

Result  :=  Number.Of  (The.Item,  In_The_Bag) ; 
end  Nuinber.Of; 

procedure  Is.Enpty  (The.Bag  :  in  Bag; 

Result  :  out  Boolean)  is 

begin 

Resul t  : -  Is.Empty ( The_Bag ) ; 
end  Is.Enpty; 

procedure  Is^_Member  (The.Item  :  in  Item; 

Of_The.Bag  :  in  Bag; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is^AJdember  (The.Item, Of.The.Bag)  ; 
end  Is.AJ^ember; 

procedure  Is^A^Subset  (Left  :  in  Bag; 

Right  :  in  Bag; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is.A._Subset (Left, Right ) ; 
end  Is.A.Subset; 

procedure  Is.A^Proper.Subset  (Left  :  in  Bag; 

Right  :  in  Bag; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is.A_Proper.Subset (Left, Right )  ; 
end  Is^A^Proper.Subset; 

end  of  modification. 


function  Is.Equal  (Left  :  in  Bag; 

Right  :  in  Bag)  return  Boolean  is 
Left.Count  :  Natural  0; 

Right.Co\int  :  Natural  :=  0; 

Left.Index  :  Bag  ;=  Left; 

Right.Index  :  Bag; 

begin 

while  Left.Index  /=  null  loop 
Right.Index  :=  Right; 
while  Right.Index  null  loop 

if  Left.Index.  The.I  tern  :=  Right.Index .  The.Item  then 
exit; 

else 

Right.Index  ;=  Right.Index.Next; 
end  if; 
end  loop; 

if  Right.Index  =  null  then 
return  False; 

elsif  Left.Index. The.Count  /=  Right.Index . The.Count  then 
return  False; 

else 

Left.Co\int  :=  Left.Count  +  1; 

Left.Index  :=:  Left.Index. Next; 
end  if; 
end  loop; 

Right.Index  :=  Right; 

while  Right.Index  /=  null  loop 

Right.Count  :=  Right.Count  1; 

Right.Index  :=  Right.Index.Next; 
end  loop; 

return  (Left.Count  =  Right.Count) ; 
end  Is.Equal; 

function  Extent.Of  (The.Bag  :  in  Bag)  return  Natural  is 
Count  ;  Natural  ;=  0; 

Index  :  Bag  :=  The.Bag; 

begin 

while  Index  /=  null  loop 

Count  :=  Count  +  Index . The.Count ; 

Index  :=  Index. Next; 
end  loop; 
return  Coxint; 
end  Extent.Of; 

function  Unique.Extent.Of  (The.Bag  :  in  Bag)  return  Natural  is 
Count  ;  Natural  :=  0; 

Index  ;  Bag  :=  The.Bag; 

begin 

while  Index  /=  null  loop 
Count  :=  Count  +  1; 

Index  :=  Index. Next; 
end  loop; 
return  Count; 
end  Unique.Extent.Of; 

function  Number.Of  (The.Item  :  in  Item; 

In_The.Bag  :  in  Bag)  return  Positive  is 
Index  :  Bag  :=  In.The.Bag; 
begin 

while  Index  /=  null  loop 

if  The.Item  =  Index. The.Item  then 
return  Index . The.Count ; 

else 

Index  Index. Next; 

end  if; 
end  loop; 

raise  IteirL.IsJNot.In.Bag; 
end  Number.Of; 

function  Is.Eirpty  (The.Bag  :  in  Bag)  return  Boolean  is 
begin 

return  (The.Bag  =  null); 
end  Is.Eopty; 

function  Is.A_iMember  (The.Item  :  in  Item; 

Of.The_Bag  :  in  Bag)  return  Boolean  is 
Index  ;  Bag  :=  Of.The.Bag; 
begin 

while  Index  /=  null  loop 

if  The.Item  =  Index. The.Item  then 
return  True; 
end  if; 

Index  Index. Next; 

end  loop; 
return  False; 
end  Is^AJMember; 

function  Is_A-.Subset  (Left  ;  in  Bag; 

Right  :  in  Bag)  return  Boolean  is 
Left.Index  :  Bag  ;=  Left; 

Right.Index  :  Bag; 
begin 

while  Left_Index  /=  null  loop 
Right.Index  ; =  Right ; 
while  Right.Index  /=  null  loop 

if  Left.Index. The.I tern  =  Right.Index. The.I tern  then 
exit; 

else 

Right.Index  :=  Right.Index.Next; 
end  if; 
end  loop; 

if  Right.Index  =  null  then 
return  False; 

elsif  Left.Index. The.Count  >  Right.Index . The.Count  then 
return  False; 

else 

Left.Index  :=  Lef t.lndex. Next; 
end  if; 
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end  loop; 
return  True; 
end  Is_^Subset; 

function  Is_A_Proper_Subset  (Left  :  in  Bag; 

Right  :  in  Bag)  return  Boolean  is 
Unique_Left_Count  :  Natural  :=  0; 

Unique_Right_Count  :  Natural  :=  0; 

Total_Left_Coxint  :  Natural  0; 

Total_Right_Count  :  Natural  :=  0; 

Left_Index  :  Bag  :=  Left; 

Right^Index  :  Bag; 

begin 

while  Left_lndex  I-  null  loop 
Right_Index  :=  Right; 
while  Right_Index  /=  null  loop 

if  Left„Index.The_Item  =  Right^Index . The_Itein  then 
exit; 

else 

Right_Index  :=  High t_Index. Next ; 
end  if; 
end  loop; 

if  Right^Index  *  null  then 
return  False; 

elsif  Left_Index.The_Count  >  Right^Index . The_Count  then 
return  False; 

else 

Unique_Left_Count  :=  Unique_Lef  t_Cotjnt  +  1; 
Total_Left„Count  :=  Total^Lef t_Coxint  + 

Lef t_Index . The_Count ; 

Le f t_Index  : =  Lef t_Index . Next ; 


end  if; 
end  loop; 

Riglit_Index  :=  Right; 

while  Right_lndex  /=  null  loop 

Unique_Right_Count  :=  Unique_Right_Count  +  1; 
Total_Right_Count  :=  Total_Right_Count  + 

Right_Index .  The_Count  ; 

Right_Index  :=  Right„Index . Next ; 
end  loop; 

if  Unigue_Left_Count  <  Unique_Right_Count  then 
return  True; 

elsif  Unique_Left_Count  >  Unigue_Right„Count  then 
return  False; 

else 

return  (Total_Lef t^Count  <  Total_Right_Count) ; 
end  if; 

end  ls_A_Proper_Subset ; 

procedure  Iterate  (Over_The_Bag  ;  in  Bag)  is 
The^Iterator  :  Bag  :=  Over_The_Bag ; 

Continue  :  Booleein; 

begin 

while  The_Iterator  /=  null  loop 

Process (The_Iterator .The_Item,  The_Iterator .The_Count, 

Continue) ; 

exit  when  not  Continue; 

The_Iterator  :=  The_Iterator .Next; 
end  loop; 
end  Iterate; 

end  Bag„Siit5)le_Sequential_UnboundedJlanaged_Iterator ; 
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BAG  SIMPLE  SEQUENTIAL  UNBOUNDED  MANAGED  ITERATOR 

PSDL 


TYPE  Bag_Simple_Sequential_Unboi2ndedUManaged_ 
SPECIFICATION 
GENERIC 

Item  ;  PRIVATE^TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

FrotrL,The_Bag  :  Bag, 

To_The_Bag  :  Bag 
OUTPUT 

To_The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  ItenL.Is_Not_In_Bag 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Bag  :  Bag 
OUTPUT 

The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  ItenulS-Not„IrL_Bag 

END 

OPERATOR  Add 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

To_The_Bag  ;  Bag 
OUTPUT 

To_The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  IteitL_Is_Not_In_Bag 

END 

OPERATOR  Remove 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

From_The_Bag  :  Bag 
OUTPUT 

From_The^Bag  :  Bag 
EXCEPTIONS 

Overflow,  Item_Is_Not^In_Bag 

END 

OPERATOR  Union 
SPECIFICATION 
INPUT 

Of_The_Bag  :  Bag, 

And^The_Bag  :  Bag, 

To_The_Bag  :  Bag 
OUTPUT 

To_The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  ItenuIs,JJot_In_Bag 

END 

OPERATOR  Intersection 
SPECIFICATION 
INPUT 

Of_The_Bag  :  Bag, 

AncLThe__Bag  :  Bag , 

To_The_Bag  :  Bag 
OUTPUT 

To_The_Bag  :  Bag 
EXCEPTIONS 

Overflow ,  I tertu.Is_No t_In__Bag 

END 

OPERATOR  Difference 
SPECIFICATION 
INPUT 

Of_The_Bag  :  Bag, 

AncLThe_Bag  :  Bag, 

To_The_Bag  :  Bag 
OUTPUT 

To_The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  Itein_Is_Not_In_Bag 

END 

OPERATOR  Is^Equal 
SPECIFICATION 
INPUT 


.Iterator 


Left  :  Bag, 

Right  ;  Bag 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  ItenL.Is_Not_In_Bag 

END 

OPERATOR  Extent_Of 
SPECIFICATION 
INPUT 

The_Bag  :  Bag 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  IteiiuXs_Not_In^Bag 

END 

OPERATOR  Unique_Extent_Of 
SPECIFICATION 
INPUT 

The_Bag  :  Bag 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Item_Is_Not_In__Bag 

END 

OPERATOR  Is_Etrpty 
SPECIFICATION 
INPUT 

The_Bag  :  Bag 
OUTPUT 

Result  ;  Boolean 
EXCEPTIONS 

Overflow,  Item_Is_Not_In_Bag 

END 

OPERATOR  Is_AJIember 
SPECIFICATION 
INPUT 

The_Item  ;  Item, 

Of_The_Bag  ;  Bag 
OUTPUT 

Result  ;  Boolean 
EXCEPTIONS 

Overflow,  Item_Is_JNot_In_Bag 

END 

OPERATOR  Is_A_Subset 
SPECIFICATION 
INPUT 

Left  :  Bag, 

Right  :  Bag 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Item_IsJNot_In_Bag 

END 

OPERATOR  Is_A-Proper_Subset 
SPECIFICATION 
INPUT 

Left  :  Bag, 

Right  ;  Bag 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Item_IsJMot_In_Bag 

END 

OPERATOR  Iterate 
SPECIFICATION 
GENERIC 

Process  :  PROCEDURE tThe_Item  ;  intt  :  Item],  The_Count  :  in[t 
Positive],  Continue  :  outtt  :  Boolean]] 

INPUT 

Over_The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  Item_lsJNot_In_Bag 

END 


END 

IMPLEMENTATION  ADA  Bag_Siii5)le_Set3uential_UnboundedJ«anage<i_Iterator 
END 
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BAG  SIMPLE  SEQUENTIAL  UNBOUNDED  MANAGED  NONITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

package  Bag_Siirple_Seguential_Unbounded_^anaged_Noniterator  xs 


type  Bag  is  limited  private; 


procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 


Copy 

Clear 

Add 

Remove 

Union 

Intersection 

Difference 


( From_The_Bag 
To_The_Bag 
{The_Bag 
{The_ltem 
To__The_Bag 
(The_Item 
From_The_Bag 
(Of_The_Bag 
And_The_Bag 
To_The„Bag 
(Of_The_Bag 
And_The_Bag 
To_The_Bag 
(Of_The_Bag 
And^'rhe_Bag 
To_The_Bag 


in 

Bag; 

in 

out 

Bag) 

in 

out 

Bag) 

in 

Item 

in 

out 

Bag) 

in 

Item 

in 

out 

Bag) 

in 

Bag; 

in 

Bag; 

in 

out 

Bag) ; 

in 

Bag; 

in 

Bag; 

in 

out 

Bag)  i 

in 

Bag; 

in 

Bag; 

in 

out 

Bag)  ; 

—  modified  by  Tuan  Nguyen  and  Vincent  Hong 

—  date:  7  April  1995 

—  adding  procedures  to  replace  functions 


Result 

:  out  Boolean) ; 

procedure  Is_A-Meint)er 

{The_Item 

:  in  Item; 

Of_The_Bag 

:  in  Bag; 

Result 

;  out  Boolean) ; 

procedure  Is_A_Subset 

(Left 

:  in  Bag; 

Right 

:  in  Bag ; 

Result 

:  out  Boolean) ; 

procedure  Is_A_Proper_Subset 

(Left 

;  in  Bag ; 

Right 

:  in  Bag; 

Result 

;  out  Boolean) ; 

end  of  modification 

function  Is_Equal 

(Left  : 

in  Bag; 

Right  : 

in  Bag)  return  Boolean 

function  Extent_Of 

(The_Bag  : 

in  Bag)  return  Natural 

fxinction  Unique_Extent_Of 

{The_Bag  : 

in  Bag)  return  Natural 

f\jnction  Number^Of 

(The^Item  : 

in  Item; 

In_The_Bag  : 

in  Bag)  return 

Ltive; 

fvinction  Is_Enpty 

(The_Bag  ; 

in  Bag)  return  Boolean, 

function  Is.AJIeinber 

{The_Item  : 

in  Item; 

Of_The_Bag  : 

in  Bag)  return  Boolean, 

function  Is_AwSubset 

(Left  : 

in  Bag; 

Right  : 

in  Bag)  return  Boolean; 

function  Is_A^Proper_Subset 

(Left  : 

in  Bag; 

Right  : 

in  Bag)  return  Booleein; 

procedure  Is_Equal 


procedure  Extent^Of 
procedure  Unique_Extent_Of 
procedure  Is^Empty 


(Left 

Right 

Result 

(The_Bag 

Result 

{The_Bag 

Result 

(The_Bag 


in  Bag; 
in  Bag; 
out  Boolean) ; 
in  Bag; 
out  Natural); 
in  Bag; 
out  Natural)  ; 
in  Bag; 


Overflow  :  exception; 

Item_IS-.Not_In_Bag  :  exception; 

private 

type  Node; 

type  Bag  is  access  Node; 

end  Bag_Sirrple_Sequential_Unbotmded_Managed_Noni terator ; 
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BAG  SIMPLE  SEQUENTIAL  UNBOUNDED  MANAGED  NONITERATOR 

ADA  IMPLEMENTATION 


—  (C)  Copyright  1986.  1987.  1988.  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Computer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood. 

—  Colorado  80227  (1-303-987-1874) 

with  Storage_Manager_Sequential ; 

package  body  Bag_Sin5Jle_Seguential_Unboimded_Managed_Noniterator  is 

type  Node  is 
record 

The_Item  :  Item; 

The_Co\mt  :  Positive; 

Next  :  Bag ; 

end  record; 

procedure  Free  (The^ode  :  in  out  Node)  is 
begin 

The_Node-The_Count  :=  1; 
end  Free; 

procedure  SetJNext  {The_Node  :  in  out  Node; 

To_JJext  :  in  Bag)  is 

begin 

The JMode. Next  :=  To_JNext; 
end  Set_Next; 

function  Next^Of  (The_Node  :  in  Node)  return  Bag  is 
begin 

return  The^ode.Next; 
end  Next^Of; 

package  Node^Manager  is  new  storage_Manager_Sequential 

(Item  =>  Node, 

Pointer  =>  Bag, 

Free  =>  Free, 

Set_Pointer  =>  Set_Next, 
Pointer_Of  =>  Next^Of ) ; 

procedure  Copy  (Fron\_The_Bag  :  in  Bag; 

To_The_Bag  :  in  out  Bag)  is 
From_Index  ;  Bag  :=  From_The_Bag ; 

To_Index  :  Bag ; 
begin 

Node_Jlanager ,  Free  (To_The_Bag)  ; 
if  FronuThe_Bag  /=  null  then 

To_The_Bag  :=  Node_Manager  .New_Item; 
To_TheZBag,The_Item  :=  FrortL^Index.The^Item; 

To_The_Bag .  The_Count  :=  From_lndex .  The_Count ; 

To^Index  :  =  To__The_Bag  ; 

From_^Index  :=  From_ Index. Next; 
while  From_Index  /=  null  loop 

To_Index.Next  :=  Node_Jlanager .New_Item; 

To_Index  :=  To_Index.Next ; 

To_Index.The_Item  :=  From^Index.The_Item; 
To_Index.The_Count  :=  From_Index,The_Count; 
Froin_Index  :=  From^Index.Next; 
end  loop ; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Copy; 

procedure  Clear  (The_Bag  :  in  out  Bag)  is 
begin 

Node_Jlanager .  Free  ( The_Bag )  ; 
end  Clear; 

procedure  Add  (The_Item  :  in  Item; 

To_The_Bag  :  in  out  Bag)  is 
Temporary JNode  :  Bag  ; 

Index  ;  Bag  :=  To_The_Bag; 

begin 

while  Index  /=  null  loop 

if  Index. The_Item  =  The_Item  then 

Index. The_Count  :=  Index . The^Count  +  1; 
return; 

else 

Index  :=  Index. Next; 
end  if; 
end  loop; 

Teitporary_Node  :=  Node Jlanager.New^I tern; 

Tenporary_Node .  The_Item  :=  The_Item; 

Teirporary_Node .  The_Coxjnt  :  =  1 ; 

Teiiporary_Node.Next  :=  To_The_Bag; 

To_Ihe_Bag  : «  Temporary_Node ; 
exception 

when  Storage_Error  => 
raise  Overflow; 


end  Add; 

procedure  Remove  (The_Item  :  in  I tern; 

From_The_Bag  :  in  out  Bag)  is 
Previous  :  Bag; 

Index  :  Bag  :=  FroirL.The_Bag; 
begin 

while  Index  /=  null  loop 

if  Index. The_I tern  =  The_ltem  then 
if  Index . The_Count  >  1  then 

Index ,  The_Cotmt  :=  Index .  The_Co\mt  -  1; 
elsif  Previous  =  null  then 

From_The_Bag  :=  FroirL.The_Bag.Next ; 

Index. Next  null; 

Node..Manager .  Free  ( Index )  ; 

else 

Previous .Next  :=  Index. Next; 

Index , Next  : =  null ; 

Node_Manager . Free ( Index) ; 
end  if; 
return; 

else 

Previous  : =  Index ; 

Index  :=  Index. Next; 
end  if; 
end  loop; 

raise  Item_Is_Not_In_Bag; 
end  Remove; 

procedure  Union  (Of_The_Bag  :  in  Bag; 

And_The_Bag :  in  Bag ; 

To_The_Bag  :  in  out  Bag)  is 

Froir\_Index  :  Bag  :=  Of_The_Bag; 

To_Index  :  Bag ; 

To_Top  :  Bag ; 

Teirporary_Node  :  Bag; 

begin 

Node_Manager . Free ( To_The_Bag ) ; 
while  Frort\_Index  /=  null  loop 

Tenpor ary _Node  :  =  Node JManager .  New„I tem ; 
Temporary_Node.The_Item  :=  FronL.Index.The_Item; 
Teaporary_Node.The_Count  :=  Fronuindex . The_Count ; 
Temporary_Node.Next  :=  To_The_Bag; 

To_The_Bag  :=  Tenporary_Node ; 

FrortL.Index  :=  FrorrL.Index.Next; 
end  loop; 

Froit\_Index  :=  And_The_Bag; 

To_Top  : =  To_Th€_Bag ; 
while  Frortv_Index  /=  null  loop 
To_Index  :=  To_Top; 
while  To_Index  /-  null  loop 

if  FronL_Index.The_Item  =  To_Index.The_Itein  then 
exit; 

else 

To_Index  : =  To_Index . Next ; 
end  if; 
end  loop; 

if  To_Index  =  null  then 

Teirporary _Node  :  =  NodeJManS'Ue^  •  New_I  t em ; 
TemporaryJlode.The_Item  ;=  FroiruIndex.The_Item; 
Teirporary_Node.The_Count  Frorr\_Index.The_Count; 
Teirpor  ary  JNode.  Next  :=  To_The_Bag; 

To_The_Bag  :=  Teiiporary_Node  ; 

else 

To_Index . The_Coun t  : = 

To_Index,The_Count  +  From_Index.The_Count  ; 
end  if; 

Frort\_Index  :=  From_Index.Next; 
end  loop; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Union; 


procedure  Intersection  (Of_The_Bag  :  in  Bag; 

AndLThe_Bag  :  in  Bag ; 

To_The_Bag  ;  in  out  Bag)  is 

Of_Index  :  Bag  ;=  Of_The_Bag; 

And_Index  :  Bag; 

Teirporary_Node  :  Bag  ; 
begin 

Node_Manager . Free ( To_The_Bag ) ; 
while  Of_Index  /-  null  loop 
And_Index  ; =  And_The_Bag ; 
while  AnoLIndex  /=  null  loop 

if  Of_Index.The_It€m  =  And_Index . The_Item  then 
Teitporary_Node  :=  Node_Manager  .New_Item; 
Teirporary_Node . The_I tem  ;=  Of_Index.The_Item; 
if  Of_Index.The_Count  <  And^Index . The_Count  then 
TenporaryJIode .  The_Count  :  = 

Of_Index . The_Count ; 

else 

Teitporary_Node .  The_Count  :  = 


And_Index .  The_,Count ; 

end  if; 

Terrporary_Node  .Next  :=  To_The_Bag; 
To_The_Bag  : =  Tenporary_Node ; 
exit ; 
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else 

And_Index  :=  And_Index.Next; 
end  if; 
end  loop; 

Of_Index  :=  Of_Index.Next; 
end  loop; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Intersection; 

procedure  Difference  (Of_The_Bag  :  in  Bag; 

AndLThe^Bag  :  in  Bag; 

To_The„Bag  :  in  out  Bag)  is 

Of^Index  :  Bag  :=  Of_The_Bag; 

And_Index  :  Bag; 

Tecnporary^JJode  :  Bag; 

begin 

Node Jlanager . Free { To_The_Bag ) ; 
while  Of_Index  /=  null  loop 
And.Index  AndLThe_Bag; 
while  And_Index  /=  null  loop 

if  Of_Index.The_Item  =  And_Index.The_Item  then 
exit; 

else 

AncLIndex  :=  And_Index.Next; 
end  if; 
end  loop; 

if  And_Index  =  null  then 

Tenporary_Node  :=  Nodejlanager  .New_Item; 
Tenporary_;Jode.The_Item  :=  Of_Index.The_Item; 
TeirporaryJNode.The_Count  :=  Of_Index.The_Count ; 
Teit5>orary_Node.Next  ;=  To_The_Bag; 

To_The_Bag  :=  Temporary JNfode; 
els  if  Of_Index.The_Count  >  And_Index .  The_Count  then 
Teiiporary_Node  :=  Node_Manager  .New_Item; 
Tenporary_Node.The_Item  :=  Of_Index.The_Item; 
Teitporary_JJode.The_Count  Of_Index.The_Count  - 
And_Index .  The_Count  ; 
Terapor ary_^ode .  Next  :  =  To_The_Bag ; 

To_The_Bag  :=  Teirporary_JIode; 
end  if; 

Of^Index  ;=  Of_Index.Next; 
end  loop; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Difference; 

modified  by  Tuan  Nguyen  and  Vincent  Hong 
date:  8  April  1995 

adding  procedures  to  replace  fxmctions 

procedure  Is_Egual  (Left  :  in  Bag; 

Right  :  in  Bag; 

Result  :  out  Boolean)  is 

begin 

Result  ;=  Is_Egual (Left, Right) ; 
end  Is^Equal; 

procedure  Extent_Of  {The_Bag  :  in  Bag; 

Result  :  out  Natural)  is 

begin 

Result  : =  Extent_Of ( The_Bag ) ; 
end  Extent_Of; 

procedure  Unique_Extent_Of  (The„Bag  ;  in  Bag; 

Result  :  out  Natural)  is 

begin 

Result  :=  Unique_Extent_Of  (The^Bag) ; 
end  Unique_Extent_Of ; 

procedure  Nuinber_Of  (The_Item  :  in  Item; 

In_The_Bag  :  in  Bag; 

Result  :  out  Positive)  is 

begin 

Result  :=  Number^Of (The_Item,In_The_Bag) ; 
end  Number_Of; 

procedure  Is^Enpty  {The_Bag  :  in  Bag; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is_Ertpty  (The_Bag) ; 
end  Is^Empty; 

procedure  Is_AJMeinber  (The_Item  :  in  Item; 

Of_The_Bag  :  in  Bag; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is^A^Member (The_Item,Of_The_Bag) ; 
end  Is_A_Nember; 

procedure  Is^A^Subset  (Left  :  in  Bag; 

Right  :  in  Bag; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is_A_Subset (Left, Right ) ; 
end  Is_A_Subset; 

procedure  Is_A_Proper_Subset  (Left  :  in  Bag; 

Right  :  in  Bag; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is_A^Proper_Subset (Left,  Right)  ; 
end  Is^A^Proper_Subset; 

end  of  modification 


function  ls_Egual  (Left  :  in  Bag; 

Right  :  in  Bag)  return  Boolean  is 
Left_Count  :  Natural  :=  0; 

Right_Count  :  Natural  :=  0; 

Left_Index  :  Bag  ;=  Left; 

Right_Index  ;  Bag; 

begin 

while  Left_Index  /=  null  loop 
Right_Index  :=  Right; 
while  Right_Index  /=  null  loop 

if  Left_Index.The_Item  =  Right_Index,The_Item  then 
exit; 

else 

Right_Index  :=  Right_Index.Next; 
end  if; 
end  loop; 

if  Right_Index  =  null  then 
return  False; 

els if  Left_Index.The_Count  /=  Right_Index . The_Count  then 
return  False; 

else 

Left_Count  :=  LeftjCount  +  1; 

Left_Index  :=  Left_Index.Next; 
end  if; 
end  loop; 

Right_Index  :=  Right; 

while  Right^Index  /=  null  loop 

Right_Co'unt  :=  Right_Count  +  1; 

Right_Index  ;=  Right^Index.Next ; 
end  loop; 

return  (Left^Count  =  Right_Count ) ; 
end  Is_Equal; 

function  Extent_Of  (The_Bag  :  in  Bag)  return  Natural  is 
Count  ;  Natural  :=  0; 

Index  :  Bag  :=  The^Bag; 

begin 

while  Index  /=  null  loop 

Count  :=  Count  +  Index. The_Count; 

Index  :=  Index. Next; 
end  loop; 
return  Cotint; 
end  Extent_Of; 

function  Unigue_Extent_Of  (The^Bag  :  in  Bag)  return  Natural  is 
Count  :  Natural  :=  0; 

Index  :  Bag  ;=  The_Bag; 

begin 

while  Index  /=  null  loop 
Count  :=  Count  +  1; 

Index  :=  Index. Next; 
end  loop; 
return  Count; 
end  Unique_Extent_Of ; 

function  Number_Of  (The_Item  :  in  Item; 

In_The_Bag  :  in  Bag)  return  Positive  is 
Index  :  Bag  :=  In_The_Bag; 
begin 

while  Index  /=  null  loop 

if  The_Item  =  Index. The_I tern  then 
return  Index. The^Count; 

else 

Index  :=  Index. Next; 
end  if; 
end  loop; 

raise  Item_Is_Not_In_Bag; 
end  Number_Of; 

function  Is_Enpty  (The_Bag  :  in  Bag)  return  Boolean  is 
begin 

return  (The_Bag  =  null) ; 
end  Is_Enipty; 

function  Is„,AuJieif>ber  (The__Item  :  in  Item; 

Of_The_Bag  :  in  Bag)  return  Boolean  is 
Index  :  Bag  :=  Of_The_Bag; 
begin 

while  Index  /=  null  loop 

if  The_Item  =  Index. The_I tern  then 
return  True; 
end  if; 

Index  :=  Index. Next; 
end  loop; 
return  False; 
end  Is,.J^_Nember  ; 

function  Is^A^Subset  (Left  :  in  Bag; 

Right  ;  in  Bag)  return  Boolean  is 
Left_Index  :  Bag  :=  Left; 

Right_Index  :  Bag; 
begin 

while  Left_Index  /=  null  loop 
Right_Index  :=  Right; 
while  Right_ Index  /=  null  loop 

if  Left_Index.The_ltem  =  Right_Index.The_Item  then 
exit; 

else 

Right_Index  Right_Index.Next; 
end  if; 
end  loop; 

if  Right_lndex  =  null  then 
return  False; 

elsif  Left_Index.The_Count  >  Right_lndex . The_Count  then 
return  False; 

else 

Left_Index  :=  Left_Index.Next; 
end  if; 
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end  loop; 
return  True; 
end  Is_A^Subset; 

function  Is^A^Proper_S\ibset  {Left  :  in  Bag; 

Right  ;  in  Bag)  return  Boolean  is 
Unigue_Left_Count  :  Natural  ;=  0; 

Unique_Right_Count  ;  Natural  :=  0; 

Total_Left_Count  :  Natural  :=  0; 

Total_Right^Cotmt  :  Natural  0; 

Left_Index  ;  Bag  :=  Left; 

Right_Index  ;  Bag ; 

begin 

while  Left_Index  j-  null  loop 
Right_Index  : =  Right ; 
while  Right _Index  /=  null  loop 

if  Left_Index.The_Item  =  Right_Index.The_Item  then 
exit  ; 

else 

Right_Index  :=  Right_Index.Next; 
end  if; 
end  loop; 

if  Right^Index  =  null  then 
return  False; 

elsif  Left_Index.The„Count  >  Right_Index . The_Count  then 


return  False; 

else 

Unique_Lef t_Count  ;=  Unigue_Lef t_Count  + 
Total_Lef t__Count  :=  Total^Lef t_,Count  + 

Lef t_Index . The_Count ; 

Left_Index  ;=  Left_Index.Next; 
end  if; 
end  loop; 

Right_Index  :=  Right; 

while  Right_Index  /=  null  loop 

Unique_Right_Count  ;=  Unique_Right_Co\mt  +  1; 
Total_Right_Count  :=  Total_Right_Count  + 
Right_Index . The^Count ; 

Hight_Index  :=  Right_Index.Next; 
end  loop; 

if  Unique_Left_Count  <  Unique_Right_Count  then 
return  True; 

elsif  Unique_Left_Coiint  >  Unique_Right_Count  then 
return  False; 

else 

return  {Total„Left_Count  <  Total_Right_Count ) 
end  if; 

end  Is_Jl_Proper_Subset ; 

end  Bag_Sinple_Sequential_Unbounded_Managed^oniterator ; 
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BAG  SIMPLE  SEQUENTIAL  UNBOUNDED  MANAGED  NONITERATOR 

PSDL 


TYPE  Bag_Siinple_Sequential_UnboimdedJManaged_Noniterator 
SPECIFICATION 
GENERIC 

Item  ;  PRIVATE_TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

FronuThe_Bag  :  Bag, 

To_The_Bag  :  Bag 
OUTPUT 

To_The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  Item_Is_Not^In_Bag 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Bag  ;  Bag 
OUTPUT 

The^Bag  :  Bag 
EXCEPTIONS 

Overflow,  ItenL.Is_Not_In_Bag 

END 

OPERATOR  Add 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

To_The_Bag  :  Bag 
OUTPUT 

To_The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  Iterr^_Is_Not_In_Bag 

END 

OPERATOR  Remove 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

Prom_The_Bag  ;  Bag 
OUTPUT 

FrorruThe_Bag  :  Bag 
EXCEPTIONS 

Overflow,  Iteii\_Is_Not_In_Bag 

END 

OPERATOR  Union 
SPECIFICATION 
INPUT 

Of_The_Bag  :  Bag, 

AncLThe__Bag  :  Bag, 

To_The_Bag  :  Bag 
OUTPUT 

To_The_Bag  ;  Bag 
EXCEPTIONS 

Overflow,  Item_Is_Not_In_Bag 

END 

OPERATOR  Intersection 
SPECIFICATION 
INPUT 

Of_The_Bag  :  Bag, 

And_The_Bag  :  Bag, 

To_The_Bag  ;  Bag 
OUTPUT 

To_The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  Iteit\_Is_Not_In_Bag 

END 

OPERATOR  Difference 
SPECIFICATION 
INPUT 

Of_The_Bag  :  Bag, 

An<i_The_Bag  :  Bag, 

To_The_Bag  :  Bag 
OUTPUT 

To_The_Bag  :  Bag 
EXCEPTIONS 


Overflow,  ItenL.Is_Not_In_Bag 

END 

OPERATOR  Is_Equal 

SPECIFICATION 

INPUT 

Left  ;  Bag, 

Right  :  Bag 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  ItenuIs^ot_In_Bag 

END 

OPERATOR  Extent_Of 

SPECIFICATION 

INPUT 

The_Bag  :  Bag 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  lteiru.ls_Not_In_Bag 

END 

OPERATOR  Unique_Extent_Of 

SPECIFICATION 

INPUT 

The_Bag  :  Bag 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  IteitL.ls_Not_In_Bag 

END 


OPERATOR  Is_En?)ty 

SPECIFICATION 

INPUT 

The_Bag  ;  Bag 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  IterruIs_Not_In_Bag 

END 

OPERATOR  Is^A_:Member 

SPECIFICATION 

INPUT 

The_Item  :  Item, 

Of_The_Bag  :  Bag 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Item^Is_Not_In_Bag 

END 

OPERATOR  Is_A_Subset 

SPECIFICATION 

INPUT 

Left  :  Bag, 

Right  ;  Bag 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  IteiiL,Is_Not_In_Bag 

END 

OPERATOR  Is_A_Proper_Subset 

SPECIFICATION 

INPUT 

Left  :  Bag, 

Right  ;  Bag 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Item_Is_Not_.In_Bag 

END 


END 

IMPLEMENTATION  ADA  Bag_Sin55le_Sequential_UnboundedJManaged_Noniterator 
END 
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BAG  SIMPLE  SEQUENTIAL  UNBOUNDED  UNMANAGED  ITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

package  Bag_Siiiple_Sequential_Unboimded_Uninanaged^Iterator  is 
type  Bag  is  limited  private; 


procedure  Copy- 

procedure  Clear 
procedure  Add 

procedure  Remove 

procedure  Union 

procedure  Intersection 

procedure  Difference 


(FroiiL.The_Bag 

To_The_Bag 

(The_Bag 

(The_Itein 

To_The_Bag 

(The_Item 

From_The_Bag 

{Of_The_Bag 

And_The_Bag 

To_The_Bag 

(Of__The_Bag 

And_The_Bag 

To_The_Bag 

(Of_The_Bag 

And_The_Bag 

To_The_Bag 


:  in  Bag; 

;  in  out  Bag) ; 
:  in  out  Bag) ; 
:  in  Item; 
:  in  out  Bag) ; 
:  in  Item; 
:  in  out  Bag) ; 
:  in  Bag; 

:  in  Bag; 
in  out  Bag) ; 

:  in  Bag; 

:  in  Bag; 

;  in  out  Bag) ; 
:  in  Bag; 

;  in  Bag; 

:  in  out  Bag) ; 


—  modified  by  Tuan  Nguyen  and  Vincent  Hong 

—  date:  7  April  1995 

adding  procedures  to  replace  functions 


procedure  Is_Equal 

procedure  Extent_Of 
procedure  Unique_Extent_Of 
procedure  Is^Empty 
procedure  Is^AJIeinber 


(Left  :  in  Bag; 

Right  ;  in  Bag; 

Result  :  out  Boolean) 

(The_Bag  ;  in  Bag; 

Result  :  out  Natural) 

(The_Bag  :  in  Bag; 

Result  :  out  Natural) 

(The_Bag  :  in  Bag; 

Result  :  out  Boolean) 

(The_Item  :  in  Item; 

Of_The_Bag  :  in  Bag; 


Result  :  out  Boolean) ; 

procedure  Is_A>Subset  (Left  :  in  Bag; 

Right  :  in  Bag; 

Result  :  out  Boolean) ; 

procedure  Is^A_Proper_Sxibset  (Left  :  in  Bag; 

Right  :  in  Bag; 

Result  :  out  Boolean) ; 

end  of  modification 

function  Is_E(iual  (Left 

Right 

fxinction  Extent_Of  (The_Bag 

function  Unigue_Extent_Of  (The_Bag 
function  Number _0f  (The_Item 

In_The_Bag 

Positive; 

function  Is_Eirpty  (The_Bag 

function  Is^A-Member  (The_Item 

Of_The_Bag 

function  Is^A-.Subset  (Left 

Right 

fxinction  Is_A.PE'oper_Subset  (Left 
Right 

generic 

with  procedure  Process  (The^Item  :  in  Item; 

The_Count  ;  in  Positive; 

Continue  ;  out  Boolean)  ; 

procedure  Iterate  ( Over_The_Bag  :  in  Bag) ; 

Overflow  :  exception; 

IteiiL.Is_Not_In_Bag  ;  exception; 

private 

type  Node; 

type  Bag  is  access  Node; 

end  Bag_Siinple_Sequent ial_Unboxmded_UnmanagecLI  terator ; 


:  in  Bag; 

:  in  Bag)  return  Boolean; 

;  in  Bag)  return  Natural; 

:  in  Bag)  return  Natural; 

:  in  Item; 

:  in  Bag)  return 

:  in  Bag)  return  Boolean; 

:  in  Item; 

:  in  Bag)  return  Boolean; 

:  in  Bag; 

;  in  Bag)  return  Boolean; 

:  in  Bag; 

:  in  Bag)  return  Boolean; 


BAG  SIMPLE  SEQUENTIAL  UNBOUNDED  UNMANAGED  ITERATOR 

ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Conputer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software.  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body  Bag_Siirple_Sequential_UnboundedLUninanaged_Iterator  is 

type  Node  is 
record 

The_Item  :  Item; 

The_Count  :  Positive; 

Next  :  Bag; 

end  record; 

procedure  Copy  (From_The_Bag  :  in  Bag; 

To_The_Bag  :  in  out  Bag)  is 
From^Index  :  Bag  ;=  From_The_Bag ; 

To_Index  :  Bag; 
begin 

if  FronuThe_Bag  -  null  then 
TO_The_Bag  ;=  null; 

else 

To_The  Bag  :=  new  Node*  (The_Item  s=>  FroiruIndex.The_Item, 
^  The_Count  =>  Fron\_Index.The_Count , 

Next  =>  null) ; 

To_Index  :=  To_The_Bag; 

Frorcuindex  :=  From_Index.Next ; 
while  From_Index  /=  null  loop 

To_Index .  Next  :=  new  Node  *  (The_I  tern  => 

Fr  onuindex .  The_I  tern , 

The_Count  => 

From_Index ,  The_Count , 

Next  =>  null) ; 

To^Index  :=  To^Index.Next ; 

Froro_Index  :=  From_Index . Next ; 
end  loop; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Copy; 

procedure  Clear  (The_Bag  ;  in  out  Bag)  is 
begin 

The_Bag  :=  null; 
end  Clear; 

procedure  Add  (The_Item  :  in  Item; 

To_The_Bag  :  in  out  Bag)  is 
Index  :  Bag  :=  To_The_Bag; 
begin 

while  Index  /=  null  loop 

if  Index. The_I tern  =  The_Item  then 

Index. The_Count  :=  Index. The_Count  +  1; 
return; 

else 

Index  : =  Index . Next ; 
end  if; 
end  loop; 

To_The_Bag  ;=  new  Node*  {The_I tern  =>  The^ltem, 

The_Count  =>  1, 

Next  =>  To_The_Bag) ; 

exception 

when  Storage^Error  => 
raise  Overflow; 

end  Add; 


procedure  Union  (Of^The_Bag  ;  in  Bag; 

And_The_Bag:  in  Bag; 

To_The_Bag  :  in  out  Bag)  is 

From_Index  ;  Bag  Of_The_Bag; 

To_Index  ;  Bag; 

To_Top  :  Bag; 

begin 

To_The_Bag  :=  null; 

while  Fron\_Index  /=  null  loop 

To_The_Bag  :=  new  Node*  (The_I tern  =>  FronuIndex.The^Item, 
The_Count  =>  FronuIndex.The_Coxint, 

Next  ->  To_The_Bag) ; 

FroirL.Index  :=  From_Index .  Next  ; 
end  loop; 

From_Index  :=  AncLThe^Bag; 

ToJTop  To_The_Bag; 
while  From_Index  /=  null  loop 
To_Index  :=  To_Top; 
while  To_Index  /=  null  loop 

if  From_Index.The_Item  =  To_Index-The_Item  then 
exit; 


else 

To_Index  :=  To_Index.Next ; 
end  if; 
end  loop; 

if  To_Index  =  null  then 

To_The_Bag  :=  new  Node  ’  (The_I tern  => 
Fronulndex .  The_I  tern , 

The_Covint  -> 


Fr  om_Index .  The_Co\jnt , 


Next  =>  To_The_Bag); 


else 

To_Index . The_Count  : = 

To_Index .  The_Coiint  +  Fron\_Index .  The_Count  ; 
end  if; 

From_lndex  From_Index.Next; 
end  loop; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Union; 


procedure  Intersection  (Of_The_Bag  :  in  Bag; 

AndLThe_Bag  :  in  Bag; 

To_The_Bag  :  in  out  Bag)  is 

Of_Index  :  Bag  :=  Of_The_Bag; 

And_Index  :  Bag; 
begin 

To_The_Bag  :=  null; 
while  Of_Index  /=  null  loop 
AndLIndex  :  =  AncLThe_Bag  ; 
while  AndLIndex  /=  null  loop 

if  Of_Index.The_Item  =  And_Index.The_Item  then 

if  of_Index-The_Count  <  AndLIndex. The^Count  then 
To_The_Bag  := 

new  Node*  (The_I tern  ->  Of_Index.The_Item, 
The_Count  =>  Of_Index.The„Count, 
Next  =>  To_The_Bag) ; 


else 

To_The_Bag  := 

new  Node '  ( The_I  tern  =  >  And_Index .  The_I  tem , 
The_Count  =>  AndLIndex . The^Count , 
Next  =>  To_The_Bag) ; 

end  if; 
exit; 

else 

And_lndex  ;=  And_Index.Next ; 
end  if; 
end  loop; 

Of_Index  : =  Of_Index - Next ; 
end  loop; 
exception 

when  Storage_Error  *> 
raise  Overflow; 
end  Intersection; 


procedure  Remove  (The^Itcm  :  in  Item; 

From_The_Bag  :  in  out  Bag)  is 
Previous  ;  Bag ; 

Index  :  Bag  :=  From_The_Bag ; 
begin 

while  Index  /=  null  loop 

if  Index. The_I tem  =  The_Item  then 
if  Index. The_Count  >  1  then 

Index. The_Count  :=  Index . The^Count 
elsif  Previous  =  null  then 

From_The_Bag  :=  Fron\_The_Bag.Next; 

else 

Previous .Next  :=  Index. Next; 
end  if; 
return; 

else 

Previous  :=  Index; 

Index  :=  Index. Next; 
end  if; 
end  loop; 

raise  Iten\_Is_>Iot_In_Bag; 
end  Remove; 


procedure  Difference  (Of_The_Bag  ;  in  Bag; 

And_The_Bag  :  in  Bag; 

To_The_Bag  :  in  out  Bag)  is 

Of_Index  :  Bag  Of_The_Bag; 

AndLIndex  :  Bag ; 
begin 

To_The_Bag:=  null; 
while  Of_Index  /=  null  loop 
And_Index  :=  And_The_Bag; 
while  And_Index  /-  null  loop 

if  Of_Index,The_Item  =  AndLIndex. The_I tem 
exit; 


else 

AndLIndex  :=  AndLIndex. Next ; 
end  if; 
end  loop; 

if  AncLIndex  =  null  then 

To_The_Bag  new  Node*  (The„Item  => 
Index .  The_Item, 


Of_Index .  The_Covint , 


then 
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Next  =>  To_The_Bag) ; 

els  if  Of_Index.The_Count  >  And^Index .  The_Count  then 
To_The_Bag  ;=  new  Node '  (The_I  tern  «> 

Of _Index .  The_I  tern , 

The_Count  => 

Of_Index.The_Count  - 


AncLIndex ,  The_Count , 
end  if; 

Of_Index  :=  O f .Index. Next; 
end  loop; 
exception 

when  Storage.Error  => 
raise  Overflow; 
end  Difference; 


Next 


=>  To.The.Bag) ; 


—  modified  by  Tuan  Nguyen  and  Vincent  Hong 

—  date;  8  April  1995 

—  adding  procedures  to  replace  functions 

procedure  Is.Equal  (Left  :  in  Bag; 

Right  ;  in  Bag; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is.Equal (Left, Right) ; 
end  Is.Equal; 

procedure  Extent.Of  (The.Bag  :  in  Bag; 

Result  :  out  Natural)  is 

begin 

Resul t  : =  Extent.Of ( The.Bag ) ; 
end  Extent.Of; 

procedure  Unique_Extent_Of  {The.Bag  ;  in  Bag; 

Result  :  out  Natural)  is 

begin 

Result  :=  Unique.Extent.Of  (The.Bag); 
end  Unique.Extent.Of ; 

procedure  Number.Of  (The.Item  :  in  Item; 

In.The.Bag  ;  in  Bag; 

Result  :  out  Positive)  is 

begin 

Result  Nvunber.Of  (The.Item,  In.The.Bag)  ; 
end  Nuinber.Of; 

procedure  Is.Einpty  (The.Bag  ;  in  Bag; 

Result  :  out  Boolean)  is 

begin 

Resul  t  :  =  Is.Eitpty  ( The.Bag ) ; 
end  Is.Ert5)ty; 

procedure  Is.A^ember  (The.Item  :  in  I  tern; 

Of. The.Bag  ;  in  Bag; 

Result  :  out  Boolean)  is 

begin 

Result  :=  ls.AJlernber  (The.Item,  Of.The.Bag)  ; 
end  Is_A_Member; 

procedure  Is_A_Subset  (Left  :  in  Bag; 

Right  :  in  Bag; 

Result  :  out  Boolecin)  is 

begin 

Result  :=  Is.AwSubset (Left, Right) ; 
end  Is^A^Subset; 

procedure  Is_,A.Proper.Subset  (Left  :  in  Bag; 

Right  :  in  Bag; 

Result  :  out  Boolean)  is 

begin 

Result  :  =  Is.J^Proper.Subse t  ( Lef  t ,  Right ) ; 
end  Is.A.Proper.Svibset; 

—  end  of  modification 


function  Is.Equal  (Left  :  in  Bag; 

Right  :  in  Bag)  return  Boolean  is 
Left.Count  :  Natural  :=  0; 

Right.Count  :  Natural  :=  0; 

Lef t.Index  :  Bag  : =  Lef t ; 

Right.Index  ;  Bag; 
begin 

while  Lef t.Index  /=  null  loop 
Right.Index  :=  Right; 
while  Right.Index  /=  null  loop 

if  Lef  t.Index.  The.Item  =  Right.Index.  The.Item  then 
exit; 

else 

Right.Index  :=  High t.Index. Next; 
end  if; 
end  loop; 

if  Right.Index  =  null  then 
return  False; 

els if  Lef t.Index. The.Count  /=  Right.Index . The.Count  then 
return  False; 

else 

Left.Count  :=  Left.Count  +  1; 

Lef t.Index  :=  Le f t.Index. Next ; 
end  if; 
end  loop; 

Right.Index  :=  Right; 

while  Right.Index  /=  null  loop 

Right.Count  :=  Right.Count  +  1; 

Right.Index  :  =  Right.Index  -  Next  ; 
end  loop; 

return  (Left.Count  =  Right.Co\mt) ; 
end  Is.Equal; 


function  Extent.Of  (The.Bag  :  in  Bag)  return  Natural  is 
Count  :  Natural  :=  0; 

Index  :  Bag  ;=  The.Bag; 
begin 

while  Index  /=  null  loop 

Count  ;=  Count  +  Index . The.Count ; 

Index  :=  Index. Next; 
end  loop; 
return  Count; 
end  Extent.Of; 

fiinction  Unique.Extent.Of  (The.Bag  :  in  Bag)  return  Natural  is 
Count  ;  Natural  :=  0; 

Index  ;  Bag  ;=  The_3ag; 

begin 

while  Index  /=  null  loop 
Count  :=  Count  +  1; 

Index  :=  Index. Next; 
end  loop; 
return  Coxint; 
end  Uni<3ue.Extent.0f  ; 

function  Ntamber.Of  (The.Item  :  in  Item; 

In.The.Bag  :  in  Bag)  return  Positive  is 
Index  ;  Bag  :=  In.The.Bag; 
begin 

while  Index  /=  null  loop 

if  The.Item  =  Index. The.Item  then 
return  Index . The.Count ; 

else 

Index  :=  Index. Next; 
end  if; 
end  loop; 

raise  Item_Is_^ot.In.Bag; 
end  Nuinber.Of  ; 

function  Is_Enpty  (The_Bag  :  in  Bag)  return  Boolean  is 
begin 

return  (TheJBag  =  null); 
end  Is.Empty; 

function  Is.A^^einber  (The.Item  ;  in  Item; 

Of .The.Bag  ;  in  Bag)  return  Boolean  is 
Index  :  Bag  :=:  Of.The.Bag; 
begin 

while  Index  /=  null  loop 

if  The.Item  =  Index. The.Item  then 
return  True; 
end  if; 

Index  :=  Index. Next ; 
end  loop; 
return  False; 
end  Is_AJM€mber; 

function  Is.A^Subset  (Left  :  in  Bag; 

Right  :  in  Bag)  return  Boolean  is 
Lef t.Index  ;  Bag  ;=  Left; 

Right.Index  :  Bag ; 
begin 

while  Left.Index  /=  null  loop 
Right.Index  :=  Right; 
while  Right.Index  /=  null  loop 

if  Lef  t.Index.  The.Item  =  Right.Index .  The.Item  then 
exit; 

else 

Right.Index  :=  Right.Index. Next; 
end  if; 
end  loop; 

if  Right.Index  *  null  then 
return  False; 

els if  Left.Index. The.Count  >  Right.Index . The.Count  then 
return  False; 

else 

Left.Index  ;=  Le f t.Index. Next ; 
end  if; 
end  loop; 
return  True; 
end  Is_A>Sxibset ; 

fxinction  ls.;i^Proper.Subset  (Left  ;  in  Bag; 

Right  :  in  Bag)  return  Boolean  is 
Unique.Left.Count  ;  Natural  :=  0; 

Unique.Right.Count  :  Natural  :=  0; 

Total.Left.Count  :  Natural  :=  0; 

Total.Right.Count  :  Natural  :=  0; 

Left.Index  :  Bag  :=  Left; 

Right.Index  ;  Bag ; 

begin 

while  Left.Index  /=  null  loop 
Right.Index  :=  Right; 
while  Right.Index  /=  null  loop 

if  Lef  t.Index.  The.Item  =  Right.Index .  The.Item  then 
exit; 

else 

Right.Index  Right.Index. Next; 

end  if; 
end  loop; 

if  Right.Index  =  null  then 
return  False; 

elsif  Lef  t.Index.  The.Count  >  Right.Index.  The.Count  then 
return  False; 

else 

Unigue.Left.Count  Unique.Left.Count  +  1; 
Total.Left.Count  :=  TotalJjeft.Count  + 

Left.Index . The.Count ; 

Left.Index  :=  Lef t.Index. Next; 
end  if; 
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end  Is_A^Proper_S\ibset; 


end  loop; 

Right.Index  Right; 

while  Right_Index  /=  null  loop 

Unique_Right_Count  Unique_Right_Count  +  1; 
Total_Right_Count  :=  Total_Right_Count  + 
Right_Index . The_Count ; 

Right^Index  :=  Right_Index . Next ; 
end  loop; 

if  Unigue_Left_Count  <  Unique„Right_Co\jnt  then 
return  True; 

elsif  Unique_Left_Count  >  Unique_Right_Co;ant  then 
return  False; 

else 

return  (Total_Lef t^Count  <  Total_Right_Count) ; 
end  if; 


procedure  Iterate  ( Over_The_Bag  :  in  Bag)  is 
The_Iterator  :  Bag  :=  Over_The_Bag ; 

Continue  :  Boolean; 

begin 

while  The^Iterator  /=  null  loop 

Process  (The_Iterator  .The_Iteni,  The_Iterator  .The_Count 

Continue) ; 

exit  when  not  Continue; 

The_Iterator  :=  The_Iterator .Next; 
end  loop ; 
end  Iterate; 

end  Bag_Simple„Seq[uential_Unboxinded_UninanagecL.Iterator ; 
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BAG  SIMPLE  SEQUENTIAL  UNBOUNDED  UNMANAGED  ITERATOR 

PSDL 


TYPE  Bag_Siinple_Sequential_UnboimdecLUnmanaged^Iterator 
SPECIFICATION 
GENERIC 

Item  ;  PRIVATE_TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

FroirL_The„Bag  :  Bag, 

To_The_3ag  :  Bag 
OUTPUT 

To_The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  Iten\_ls_Jlot_In_Bag 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Bag  :  Bag 
OUTPUT 

The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  ItenuIs_Not_In_Bag 

END 

OPERATOR  Add 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

To_The_Bag  :  Bag 
OUTPUT 

To_The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  Iteia_ls_JJot_In_Bag 

END 

OPERATOR  Remove 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

FronuThe_Bag  :  Bag 
OUTPUT 

From_The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  Item_Is_Not_In_Bag 

END 

OPERATOR  Union 
SPECIFICATION 
INPUT 

Of_The_Bag  :  Bag, 

And_The_Bag  :  Bag, 

To_The_Bag  :  Bag 
OUTPUT 

To_The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  Item_IsJNot_In_Bag 

END 

OPERATOR  Intersection 
SPECIFICATION 
INPUT 

Of_The_Bag  :  Bag, 

And_The_Bag  :  Bag, 

To_The_Bag  :  Bag 
OUTPUT 

To_The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  Item_is_Not_In_Bag 

END 

OPERATOR  Difference 
SPECIFICATION 
INPUT 

Of_The_Bag  :  Bag, 

And_The_Bag  :  Bag , 

To_The_Bag  :  Bag 
OUTPUT 

To_The_Bag  :  Bag 
EXCEPTIONS 

Overflow ,  1 1 em_Is JNo t_In_Bag 

END 

OPERATOR  Is^Equal 
SPECIFICATION 
INPUT 


Left  :  Bag, 

Right  :  Bag 
OUTPUT 

Result  ;  Boolean 
EXCEPTIONS 

Overflow,  Item_Is_Not^InwBag 

END 

OPERATOR  Extent_Of 
SPECIFICATION 
INPUT 

The_Bag  :  Bag 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Item_Is_Not_In_Bag 

END 

OPERATOR  Unique_Extent_Of 
SPECIFICATION 
INPUT 

The_Bag  :  Bag 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Item_Is_Not_In_Bag 

END 

OPERATOR  Is^Empty 
SPECIFICATION 
INPUT 

The_Bag  :  Bag 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Item_IsJIot_In_Bag 

END 

OPERATOR  Is,JOIember 
SPECIFICATION 
INPUT 

The^Item  :  Item, 

Of_The_Bag  :  Bag 
OUTPUT 

Result  ;  Boolean 
EXCEPTIONS 

Overflow,  Item_Is_Not_In_Bag 

END 

OPERATOR  Is^A_Subset 
SPECIFICATION 
INPUT 

Left  :  Bag, 

Right  ;  Bag 
OUTPUT 

Result  ;  Boolean 
EXCEPTIONS 

Overflow,  Item_Is_Not_In_Bag 

END 

OPERATOR  Is_A-.Proper_Subset 
SPECIFICATION 
INPUT 

Left  :  Bag, 

Right  :  Bag 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Item_Is^ot_In_Bag 

END 

OPERATOR  Iterate 
SPECIFICATION 
GENERIC 

Process  :  PROCEDURE [The_Item  :  in[t  ;  Item],  The_Count  :  rn[t  ; 
Positive],  Continue  :  out[t  :  Boolean]] 

INPUT 

Over_The_Bag  ;  Bag 
EXCEPTIONS 

Overflow,  Itenu.ls_Not_In_Bag 

END 

END 

IMPLEMENTATION  ADA  Bag_Sin5>le_Se(3uential_Uhbounded_UnnianagedLIterator 
END 
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BAG  SIMPLE  SEQUENTIAL  UNBOUNDED  UNMANAGED  NONITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

package  Bag_Siitple_Sequential_Unboundec3jJnmanagecLNoniterator  is 
type  Bag  is  limited  private; 

procedure  Copy  ( From_The_Bag  :  in  Bag; 

To_The_Bag  ;  in  out  Bag) ; 

procedure  Clear  (The_Bag  :  in  out  Bag) ; 

procedure  Add  (The^ltem  :  in  Item; 

To_The_Bag  :  in  out  Bag) ; 

procedure  Remove  {The_Item  :  in  Item; 

Froin_The_Bag  :  in  out  Bag)  ; 

procedure  Union  {Of„The_Bag  :  in  Bag; 

And_The_Bag  :  in  Bag; 

To_T]ae_Bag  :  in  out  Bag)  ; 

procedure  Intersection  (Of_The_Bag  :  in  Bag; 

AncLThe_Bag  :  in  Bag; 

To_The_Bag  :  in  out  Bag) ; 

procedure  Difference  (Of_TheJBag  ;  in  Bag; 

AncLThe_Bag  :  in  Bag; 

To_The_Bag  :  in  out  Bag) ; 

—  modified  by  Tuan  Nguyen  and  Vincent  Hong 

—  date:  7  April  1995 

—  adding  procedures  to  replace  functions 

procedure  Is_Egual  (Left  :  in  Bag; 

Right  :  in  Bag; 

Result  :  out  Boolean) ; 

procedure  Extent_Of  (The_Bag  ;  in  Bag; 

Result  ;  out  Natural); 

procedure  Unique_Extent_Of  (The_Bag  :  in  Bag; 

Result  :  out  Natural); 

procedure  Is_En5>ty  (The_Bag  :  in  Bag; 


Result  :  out  Boolean)  ; 

procedure  Is^_Meinber  {The_Item  :  in  Item; 

Of_The_Bag  :  in  Bag; 

Result  :  out  Boolean) ; 

procedure  Is^A^Subset  (Left  :  in  Bag; 

Right  :  in  Bag; 

Result  :  out  Boolean) ; 

procedure  Is_A^Proper_Subset  (Left  :  in  Bag; 

Right  :  in  Bag; 

Result  :  out  Boolean) ; 

—  end  of  modification 

fxjnction  Is^Equal  (Left  :  in  Bag; 

Right  :  in  Bag)  return  Boolean; 

function  Extent_Of  (The^Bag  :  in  Bag)  return  Natural; 

ftinction  Unique_Extent_Of  (The_Bag  :  in  Bag)  return  Natural; 

function  Num3oer_Of  (The^Item  :  in  I  tern; 

In_The_Bag  :  in  Bag)  return 

Positive; 

function  Is^En^ity  (The_Bag  :  in  Bag)  return  Boolean; 

function  Is_J^^ember  (The_Item  :  in  I  tern; 

Of_The_Bag  :  in  Bag)  return  Boolean; 

fxmction  Is_A-.Subset  (Left  :  in  Bag; 

Right  ;  in  Bag)  return  Boolean; 

function  Is_A^Proper_S\ibset  (Left  :  in  Bag; 

Right  :  in  Bag)  return  Boolean; 

Overflow  :  exception; 

Itein_Is_Not_In_Bag  :  exception; 

private 

type  Node; 

type  Bag  is  access  Node; 

end  Bag_SiiTple_Sequential_Unbounded_Unmanaged_Noniterator ; 
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BAG  SIMPLE  SEQUENTIAL  UNBOUNDED  UNMANAGED  NONITERATOR 

ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

-Restricted  Rights  Legend " 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  {3}  (ii) 

—  of  the  rights  in  Technical  Data  and  Computer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  {1-303-987-1874} 

package  body  Bag_Siinple_Sequential_Unbounded_Urmanaged_Noniterator  is 

type  Node  is 
record 

The_Item  :  Item; 

The_Count  :  Positive; 

Next  :  Bag; 

end  record; 

procedure  Copy  (FronuThe_Bag  :  in  Bag; 

To_The_Bag  ;  in  out  Bag)  is 
Fronulndex  :  Bag  :=  FronL.The_Bag ; 

To_Index  :  Bag; 
begin 

if  FronuThe_Bag  =  null  then 
To_^The_Bag  ;  =  null  ; 

else 

To_The_Bag  ;=  new  Node' (The_I tern  =>  FroituIndex.The_Item, 
The_Count  =>  FroiiL-lndex.The_Coxint, 
Next  =>  null) ; 

To_Index  :=  To_The_Bag; 

From_Index  :=  FronuIndex.Next ; 
while  Prom_Index  /=  null  loop 

To^Index . Next  :=  new  Node ' (The_I tern  -> 

From_Index .  The_I  tem, 

The_Count  => 

Fronulndex .  The_Count , 

Next  =>  null ) ; 

To_Index  :=  To^Index.Next ; 

From_Index  :=  FroiruIndex.Next; 
end  loop; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Copy; 

procedure  Clear  (The_Bag  :  in  out  Bag)  is 
begin 

The_Bag  : =  null ; 
end  Clear ; 

procedure  Add  (The_Item  :  in  Item; 

To_TheJBag  ;  in  out  Bag)  is 
Index  :  Bag  :=  To_The_Bag; 
begin 

while  Index  /=  null  loop 

if  Index. The_I tem  =  The_Item  then 

Index. The_Coxint  Index . The_Count  +  1; 
return; 

else 

Index  : =  Index . Next ; 
end  if; 
end  loop; 

To_The_Bag  :=  new  Node '  {The_I  tem  =>  The_Item, 

The_Count  =>  1, 

Next  =>  To_The_Bag) ; 

exception 

when  Storage_Error  => 
raise  Overflow; 

end  Add; 

procedure  Remove  (The_Item  :  in  Item; 

From_The_Bag  :  in  out  Bag)  is 
Previous  :  Bag; 

Index  :  Bag  :=  Fron\_The_Bag; 

begin 

while  Index  /=  null  loop 

if  Index -The_I tem  =  The_Item  then 
if  Index, The_Count  >  1  then 

Index .  The_Count  :=  Index .  The^Count  -  1; 
elsif  Previous  =  null  then 

FrortuThe_Bag  :=  From_The_Bag.Next; 

else 

Previous. Next  :=  Index. Next; 
end  if; 
return; 

else 

Previous  :=  Index; 

Index  Index. Next; 

end  if; 
end  loop; 

raise  Item_Is_Not_In_Bag; 
end  Remove; 


procedure  Union  (Of_The_Bag  :  in  Bag; 

And_The_Bag:  in  Bag; 

To_The„Bag  ;  in  out  Bag)  is 

Fronulndex  :  Bag  Of_The_^ag; 

To_Index  :  Bag; 

To__Top  :  Bag; 

begin 

To_The_Bag  : «  null ; 

while  From_lndex  /=  null  loop 

To_The_Bag  :=  new  Node '  {The_I tem  =>  FronuIndex.The_Item, 

The_Count  =>  Frorn_Index .  The_Count , 

Next  =>  To_The_Bag) ; 

Fronuindex  : =  Fr om_Index , Next ; 

end  loop; 

Froro^Index  :=  And_The_Bag; 

To_Top  :=  To_The_Bag; 
while  Fronuindex  /=  null  loop 
To_Index  :=  To_Top; 
while  To_Index  /=  null  loop 

if  Fronulndex.The^Item  =  To_Index.The_Item  then 
exit; 


else 


To_Index  ;=  To_Index.Next; 
end  if; 
end  loop; 

if  To_Index  =  null  then 

To_The_Bag  :=  new  Node* (The_I tem  => 
Fronulndex . The_I tem, 


The^Count  -> 


Fr om_Index . The^Count , 


Next  =>  To_The_Bag) ; 


else 

To_Index . The^Count  : = 

To^Index . The_Count  +  From_Index . The_Count ; 
end  if; 

From_Index  :=  FrortuIndex.Next; 
end  loop; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Union; 


procedure  Intersection  (Of_The_Bag  :  iii  Bag; 

AndLThe_Bag  :  in  Bag; 

To_TheJBag  :  in  out  Bag)  is 

Of_.Index  :  Bag  :=  Of_The_Bag; 

And_Index  :  Bag; 
begin 

To_The_Bag  :=  null; 
while  Of_Index  /=  null  loop 
And_Index  :=  And_The_Bag; 
while  AndLIndex  /=  null  loop 

if  Of_Index.The_Item  =  AncLIndex.The_Item  then 

if  Of _Index . The„Count  <  And_Index . The_Count  then 
To_'Ihe_Bag  :  = 

new  Node' {The„I tem  =>  Of_Index,The_Item, 
The^Count  =>  Of_Index,The_Count, 
Next  ->  To_The_Bag) ; 

else 


To_The_Bag 

new  Node'  (The_Item 
The__Count 
Next 


And_Index .  The_I  tem, 
And_Index . The_Count , 
To_The_Bag) ; 


end  if; 
exit; 


else 

AncLIndex  :=  And_Index.Next; 
end  if; 
end  loop; 

0  f _Index  : =  0 f _Index . Next ; 
end  loop; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Intersection; 


procedure  Difference  (Of_The_Bag  :  in  Bag; 

AncL'rhe_Bag  :  in  Bag  ; 

To_The_Bag  :  in  out  Bag)  is 
Of_lnd€X  ;  Bag  ;=  Of_The_Bag; 

AndLIndex  :  Bag; 
begin 

To_'Ihe_Bag :  =  null; 
while  Of^Index  /=  null  loop 
And_Index  :=  AncLThe_Bag; 
while  AndLIndex  /=  null  loop 

if  Of_Index.The_Item  =  And_Index.The_Item  then 
exit; 

else 


And_lndex  :=  AncLIndex. Next ; 
end  if; 
end  loop; 

if  AndLIndex  =  null  then 

To_The_Bag  :=  new  Node ' (The_l tem  => 
Of_Index .  The_Item, 


The_Count  => 


Of_Indcx .  The_Count , 
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Next  =>  To_The_Bag); 

elsif  Of_Index.The_Count  >  And_Index . The_Count  then 
To_The_Bag  :=  new  Node'  (The_Item  => 

Of_Index .  The_I  tern, 

The_Count  => 

Of_Index .  The_Count  - 


=>  To_The_Bag) ; 


And^Index .  The_Count , 

Next 

end  if; 

Of_Index  :«  Of^Index.Next; 
end  loop; 
exception 

when  storage_Error  => 
raise  Overflow; 
end  Difference; 

—  modified  by  Tuan  Nguyen  and  Vincent  Hong 
date:  8  April  1995 

—  adding  procedures  to  replace  functions 

procedure  Is^Equal  {Left  :  in  Bag; 

Right  :  in  Bag; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is_Equal {Left, Right) ; 
end  Is^Equal; 

procedure  Extent_Of  {The_Bag  :  in  Bag; 

Result  :  out  Natural)  is 

begin 

Result  :=  Extent_Of (The„Bag) ; 
end  Extent_Of; 

procedure  Unique^Extent_Of  (The_Bag  :  in  Bag; 

Result  :  out  Natural)  is 

begin 

Result  Unique_Extent_Of  (The_Bag) ; 
end  Unigue_Extent_Of ; 

procedure  Number^Of  (The_Item  :  in  Item; 

In_The_Bag  :  in  Bag; 

Result  ;  out  Positive)  is 

begin 

Result  :=  Number_Of (The_Item, In_The_Bag) ; 
end  Nuinber_Of; 

procedure  Is_Eii53ty  (The_Bag  :  in  Bag; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is_En?)ty{The_Bag)  ; 
end  Is^Empty; 

procedure  Is_^AJlember  (The_Item  ;  in  Item; 

Of_The_Bag  :  in  Bag; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is^_Meinber{The_Item,Of_The_Bag)  ; 
end  Is^AJKember ; 

procedure  Is_A_Subset  {Left  :  in  Bag; 

Right  :  in  Bag; 

Result  :  out  Boolean)  is 

begin 

Result  ;=  Is_A_Subset (Left, Right) ; 
end  Is_A_Subset; 

procedure  Is_A^Proper_Subset  (Left  :  in  Bag; 

Right  :  in  Bag; 

Result  ;  out  Boolean)  is 

begin 

Result  :=  Is^_Proper_Subset (Left, Right)  ; 
end  Is_A_Proper_Subset ; 

—  end  of  modification 


function  Is__Equal  (Left  :  in  Bag; 

Right  :  in  Bag)  return  Boolean  is 
Left^Count  :  Natural  :=  0; 

Right_Count  :  Natural  :=  0; 

Left_Index  :  Bag  :=  Left; 

Right_Index  :  Bag; 

begin 

while  Left_Index  /=  null  loop 
Right_Index  :=  Right; 
while  Right_Index  /=  null  loop 

if  Left_Index.The_Item  =  Right_Index.The_Item  then 
exit  ; 

else 

Right^Index  :=  Right_Index . Next ; 
end  if; 
end  loop; 

if  Right_lndex  =  null  then 
return  False ; 

elsif  Left_Index.The_Count  /=  Right_Index . The_Count  then 
return  False; 

else 

Left_Count  :=  Left_Count  +  1; 

Left^Index  :=  Left_Index.Next ; 
end  if; 
end  loop; 

Right_Index  ; =  Right ; 

while  Right^Index  /=  null  loop 

Right_Count  :=  Right^Count  +  1; 

Right_Index  :=  High t_Index. Next; 
end  loop; 

return  (Left^Count  =  Right_Coiint )  ; 
end  Is_Equal; 


function  Extent_Of  {The_Bag  :  in  Bag)  return  Natural  is 
Count  :  Natural  :=  0; 

Index  :  Bag  :=  The_Bag; 

begin 

while  Index  /=  null  loop 

Count  :=  Co\mt  +  Index .  The_Count ; 

Index  :=  Index. Next; 
end  loop; 
return  Coiant; 
end  Extent_Of; 

function  Unique_Extent_Of  (The^Bag  :  in  Bag)  return  Natural  is 
Count  :  Natural  ;=  0; 

Index  :  Bag  :=  The_Bag; 
begin 

while  Index  /=  null  loop 
Coiant  :=  Count  +  1; 

Index  :=  Index. Next; 
end  loop; 
return  Count; 
end  Unique_Extent_Of ; 

function  Number_0f  (The_Item  :  in  Item; 

In_The_Bag  :  in  Bag)  return  Positive  is 
Index  :  Bag  :=  In_The_Bag; 
begin 

while  Index  /=  null  loop 

if  The_Item  Index. The_I tern  then 
return  Index . The^Cotint ; 

else 

Index  :=  Index. Next; 
end  if; 
end  loop; 

raise  I tenuis JNot_In_Bag; 
end  Nuinber_Of; 

function  Is_Empty  {The_Bag  ;  in  Bag)  return  Boolean  is 
begin 

return  (The_Bag  =  null) ; 
end  Is^Empty; 

fxinction  Is_A_Meinber  (The_Item  :  in  Item; 

Of_The_Bag  :  in  Bag)  return  Boolean  is 
Index  :  Bag  :=  Of_The_Bag; 
begin 

while  Index  /=  null  loop 

if  The_Item  =  Index. The_I tern  then 
return  True; 
end  if; 

Index  :=  Index. Next; 
end  loop; 
return  False; 
end  is^A^Member; 

function  Is_A_Subset  (Left  ;  in  Bag; 

Right  :  in  Bag)  return  Boolean  is 
Left_Index  :  Bag  :=  Left; 

Right_Index  :  Bag; 
begin 

while  Left_Index  /=  null  loop 
Right_Index  :=  Right; 
while  Right_lndex  /=  null  loop 

if  Left_Index.The_Item  =  Right_Index.The_Item  then 
exit; 

else 

Right_Index  :=  Right_Index.Next; 
end  if; 
end  loop; 

if  Right^Index  =  null  then 
return  False; 

elsif  Left_Index.The_Count  >  Right_Index.The_Count  then 
return  False; 

else 

Left_Index  ;=  Le£t_Index.Next ; 
end  if; 
end  loop; 
return  True; 
end  Is^A-Subset ; 

function  Is.^Proper_S\ibset  (Left  ;  in  Bag; 

Right  :  in  Bag)  return  Boolean  is 
Uni(5ue_Left_Count  :  Natural  ;=  0; 

Unique_Right„Count  :  Natural  :=  0; 

Total_Left_Count  :  Natural  ;=  0; 

Total_Right_Coxmt  :  Natural  :=  0; 

Left_lndex  :  Bag  :=  Left; 

Right_Index  :  Bag; 

begin 

while  Left_Index  /=  null  loop 
Right_Index  :=  Right; 
while  Right_Index  /=  null  loop 

if  Left_Index.The_Item  =  Right_Index.The_Item  then 
exit; 

else 

Right^Index  :=  Right_Index.Next ; 
end  if; 
end  loop; 

if  Right^Index  =  null  then 
return  False; 

elsif  Left_Index.The_Cotint  >  Right_Index.The_Count  then 
return  False; 

else 

Unique_Left_Count  :=  Unique_Lef t_Count  +  1; 
Total_Left_Count  :=  Total_Left_Count  + 

Lef t_Index . The_Count ; 

Left_Index  :=  Left_Index.Next ; 
end  if; 
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end  loop; 

Right_Index  ; =  Right ; 

while  Right_Index  I-  null  loop 

Unique_Right_Count  Unique_Right_Count  +  1; 
Total_Right_Count  :=  Total_Right_Count  + 
Right_Index . The_Count ; 

Right_Index  :=  Right_Index.Next ; 
end  loop; 

if  Unique_Left_Count  <  Unique_Right_Count  then 


return  True; 

elsif  Unique_Left_Count  >  Unique_Right_Count  then 
return  False; 

else 

return  {Total_Left_Count  <  Total_Right_Count) 
end  if; 

end  Is_A_Proper_Subset; 

end  Bag_S  iir¥>l  e_Sequent  ial_UnboundecLUnmanaged_Noni  tera tor 


71 


BAG  SIMPLE  SEQUENTIAL  UNBOUNDED  UNMANAGED  NONITERATOR 

PSDL 


TYPE  Bag_Siir^le_Seguential_Unboimded_UninanagecLlNoniterator 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

FrorrL_The_Bag  :  Bag, 

To_'nie_Bag  :  Bag 
OUTPUT 

To_The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  Item_Is_Not_In_Bag 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Bag  :  Bag 
OUTPUT 

The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  ItenL.IsJIot_In_Bag 

END 

OPERATOR  Add 
SPECIFICATION 
INPUT 

The_Itein  :  Item, 

To_The_Bag  :  Bag 
OUTPUT 

To_The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  ltem_Is_Not_IrL_Bag 

END 

OPERATOR  Remove 
SPECIFICATION 
INPUT 

The^Item  ;  Item, 

From_The_Bag  :  Bag 
OUTPUT 

From_The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  Itent.Is_Not_In_Bag 

END 

OPERATOR  Union 
SPECIFICATION 
INPUT 

Of_The_Bag  :  Bag, 

And_The_Bag  :  Bag, 

To_The_Bag  :  Bag 
OUTPUT 

To_The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  Itenuls_Not_In_Bag 

END 

OPERATOR  Intersection 
SPECIFICATION 
INPUT 

Of_The_Bag  :  Bag, 

And_The_Bag  :  Bag, 

To_The_Bag  ;  Bag 
OUTPUT 

To^The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  Iten\_Is^ot_InL-Bag 

END 

OPERATOR  Difference 
SPECIFICATION 
INPUT 

Of_The_Bag  ;  Bag, 

And_The_Bag  :  Bag, 

To_The_Bag  :  Bag 
OUTPUT 

To_The_Bag  :  Bag 
EXCEPTIONS 

Overflow,  ItenL.ls_Not_In_Bag 


END 

OPERATOR  Is_Equal 
SPECIFICATION 
INPUT 

Left  :  Bag, 

Right  :  Bag 
OUTPUT 

Result  :  Boolecin 
EXCEPTIONS 

Overflow,  IteircIs_^ot_In_Bag 

END 

OPERATOR  Extent^Of 
SPECIFICATION 
INPUT 

The_Bag  :  Bag 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  IteitL,Is^ot_In_Bag 

END 

OPERATOR  Unique_Extent„Of 
SPECIFICATION 
INPUT 

The_Bag  :  Bag 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  ItenuIs_Not_In_Bag 

END 

OPERATOR  Is_Einpty 
SPECIFICATION 
INPUT 

The_Bag  :  Bag 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Iteiit.Is^ot_In_Bag 

END 

OPERATOR  Is^A^ember 
SPECIFICATION 
INPUT 

The_Item  ;  Item, 

Of_The_Bag  :  Bag 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  IteiiuIs^ot_In_Bag 

END 

OPERATOR  Is^A^Subset 
SPECIFICATION 
INPUT 

Left  :  Bag, 

Right  :  Bag 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Item^Is_Not_In„Bag 

END 

OPERATOR  Is_A_Proper_Sul)set 
SPECIFICATION 
INPUT 

Left  ;  Bag, 

Right  :  Bag 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Over  f  low ,  I  tem_Is JtJo  t_In_Bag 

END 

END 

IMPLEMENTATION  ADA 

Bag_Simpl e_Sequen t ia l_Unbounded_Unmanaged_Noni t er a t or 
END 
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LIST  0BJ3  SPECIFICATIONS 


obj  LISTtX  : :  TRr7]  is  sort  List  . 
protecting  NAT  . 

***  constructors 

op  create  :  ->  List  . 

op  copy  :  List  List  ->  List  . 

op  clear  :  List  ->  List  . 

op  construct  ;  Elt  List  ->  List  . 

op  sethead  ;  List  Elt  ->  List  . 

***  op  swaptail  :  List  List  ->  List  List. 

***  cannot  be  inplemented 


***  accessors 

op  isequal  :  List  List  ->  Bool  . 

op  lengthof  ;  List  ->  Nat  . 

op  isnull  ;  List  ->  Bool  . 

op  headof  :  List  ->  Elt  . 

op  tailof  :  List  -">  List  . 

***  op  predecessorof  ;  List  ->  List 

♦**  exceptions 

op  overflow  :  ->  List  . 

op  listisnull  :  ->  List  . 


op  listisnull  :  ->  Elt  . 

op  notathead  :  ->  List  . 

♦**  variables  declaration 

var  L  LI  :  List  . 
var  E  El  :  Elt  . 

**»  axioms 

eg  copy{L,Ll)  =  L  . 

eg  clear (L)  -  create  . 

eg  sethead{create, E)  =  listisnull  - 

eg  sethead(construct(E,L) ,E1)  =  construct {El, create) 
eg  isegual{L,Ll)  =  L  ==  LI  . 
eg  lengthof {create)  =  0  , 

eg  lengthof {construct {E,L) )  =  1  +  lengthof (L)  . 

eg  isnull (L)  =  L  ==  create  . 

eg  headof (create)  =  listisnull  . 

eg  headof (construct {E,L) )  =  E  . 

eg  tailof (create)  =  create  . 

eg  tailof (construct {E,L) )  =  L  . 

eg  predecessorof (create)  =  listisnull  . 

***  eg  predecessorof (construct {E,L) )  =  listisnull  . 

endo 
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LISTS  PROFILE  CODES 


OPERATORS 

SIGNATURES 

PROFILE  CODES 

COPY 

AB->B 

3211 

CLEAR 

A->A 

2201 

CONSTRUCT 

AB->B 

3211 

SET  HEAD 

AB->  A 

3211 

IS_EOUAL 

AB->C 

330 

LENGTH.OF 

A->B 

220 

IS.NULL 

A->B 

220 

HEAD_OF 

A->B 

220 

TAIL.OF 

A->B 

220 

PREDECESSOR_OF 

A->B 

220 

SET  OF  PROFILE:  {3211 ,220 1 ,330,220 } 
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LIST  DOUBLE  BOUNDED  MANAGED 


ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

The_Size  :  in  Positive; 
package  List_po\xble_BoundedJManaged  is 

type  List  is  private; 

Null_List  :  constant  List; 

procedure  Copy  (Fron\„The„List  :  in  List; 

To_The_List  ;  in  out  List); 

procedure  Clear  (The_List  :  in  out  List) ; 

procedure  Construct  (The^Item  ;  in  Item; 

AncLThe_List  :  in  out  List) ; 

procedure  Set_Head  (0£_The_List  :  in  out  List; 

To_The_Item  :  in  Item) ; 

procedure  Swap_Tail  (Of_The_List  :  in  out  List; 

And_The_List  :  in  out  List) ; 

—  modified  hy  Vincent  Hong  and  Tuan  Nguyen 

—  date:  9  April  1995 

—  adding  procedures  to  replace  functions 

procedure  Is_Egual  (Left  :  in  List; 

Right  :  in  List; 

Result  :  out  Booleeui)  ; 

procedure  Length_Of  ( Thesis t  :  in  List; 

Result  :  out  Natural) ; 
procedure  IsJNull  (The^List  :  in  List; 


Result  :  out  Boolean) ; 
procedure  Head_Of  (The^List  :  in  List; 

Result  :  out  Item) ; 

procedure  Tail^Of  {The^List  :  in  List; 

Result  :  out  List) ; 

procedure  Predecessor_Of  {The_List  :  in  List; 

Result  :  out  List); 

—  end  of  modification 

function  Is_Equal  (Left  :  in  List; 

Right  :  in  List)  return  Boolean; 
function  Length^Of  (The_List  :  in  List)  return  Natural; 

function  IsJtJull  (The_List  :  in  List)  return  Boolean; 

function  Head_Of  (The_List  :  in  List)  return  I tern; 

function  Tail_Of  (The_List  :  in  List)  return  List; 

function  Predecessor^Of  (The_List  ;  in  List)  return  List; 

Overflow  :  exception; 

List^IsJNull  :  exception; 

Not^t_Head  :  exception; 

private 

type  List  is 
record 

The_Head  :  Natural  :=  0; 
end  record; 

Null_List  :  constant  List  :=  List  * (The_Head  =>  0); 
end  List_Double_Bounded_Managed; 


LIST  DOUBLE  BOUNDED  MANAGED 
ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 
All  Rights  Reserved 

—  Serial  N\jinber  0100219 

•Restricted  Rights  Legend" 

Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Cort^juter 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body  List_Double„BoundedLJlanaged  is 

type  Node  is 
record 

Previous  :  List; 

The^Item  ;  Item; 

Next  :  List; 

end  record; 

Heap  :  array (Positive  range  1  . .  The_Size)  of  Node; 

Free__List  :  List; 

procedure  Free  (The_List  :  in  out  List)  is 
Ten5)orary_Node  :  List; 
begin 

while  The_List  /=  Null^List  loop 
TeirporaryJJode  The_List; 

The_Lis  t  ; =  He ap ( The_Lis t . The_Head ) . Next ; 

Heap  {Ten¥)orary_Node . The_Head)  .  Previous  :  =  Null^List  ; 
Heap(Ten?)orary_Node.The_Head)  .Next  :=  Free_List; 
Free_List  :=  TeirporaryJWode  ; 
end  loop; 
end  Free; 

function  New^Item  return  List  is 
Tensor ary_.Node  :  List; 
begin 

if  Free_List  -  Null_List  then 
raise  Storage_Error; 

else 

Tenporary_Node  :=  Free_List; 

Free_List  :=  Heap (Free_List.The_Head) .Next; 

Heap  (Ten53orary_Node . The_Head)  .Next  :  =  Null_List  ; 
return  Tetnporary_Node ; 
end  if; 
end  New_,Item; 

procedure  Copy  (From_The_List  :  in  List; 

To_The_List  :  in  out  List)  is 
From_Index  :  List  :=  FrorrL.The_List ; 

To_Index  :  List; 
begin 

Free (To_The_List) ; 
if  Froin_The_List  /-  Null_List  then 
To__The_List  :  =  New_Item; 

Heap(To_The_List.The_Head) .The_Item 
Heap  ( Fr om_Index .  The_Head )  . The_I  tern; 

To_Index  :=  To_The_List; 

Fronuindex  :=  Heap(From_Index.The_Head) .Next; 
while  FronL.Index  /=  Null^List  loop 

Heap(To_Index.The_Head)  .Next  :=  New_Item; 

Heap (Heap (To^Index . The_Head) .Next . The_Head) . Previous 

To_Index; 

To_Index  ;  =  Heap  ( To_Index .  The_Head)  . Next  ; 

Heap  ( To_Index .  The^Head )  .  The_I  t em  :  = 

Heap ( Fr om_Index . The_He ad ) , The_I t em ; 

Fr oiTuIndex  :  =  Heap  ( From_Index .  The_Head )  .  Next  ; 
end  loop; 
end  if; 
exception 

when  Storage^Error  => 
raise  Overflow; 
end  Copy; 

procedure  Clear  (The_List  :  in  out  List)  is 
begin 

Free{The_List) ; 
end  Clear ; 

procedure  Construct  (The_Item  ;  in  Item; 

And_The_List  :  in  out  List)  is 
Temporary  JNode  :  List; 
begin 

if  And_The_List  =  Null_List  then 
And_The_List  :=  New_Item; 

Heap ( And_The_Lis t . The„Head) . The_I tern  ; =  The_I tern ; 
elsif  Heap(And_The_List.The_Head) .Previous  =  Null_List  then 
Temporary_Node  :=  New_Item; 

Heap  (Temporary_Node .  The_Head)  .  The_Item  :  =  The_Item; 

Heap  (Teicporary_Node  .The_Head)  .Next  :=  And_The__List ; 

Heap ( And_The_Lis  t . The_Head ) . Previous  : =  Tenpor ary_Node ; 
And-.TheJL.ist  ;=  Tert5>oraryJJode  ; 


else 

raise  Not_At_Head; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Construct; 

procediire  Set_Head  (Of_The_List  :  in  out  List; 

To_The_Item  :  in  Item)  is 

begin 

Heap ( Of _The_Lis t. The_Head)  .The_I tern  :=  To_The_Item; 
exception 

when  Cons train t_Err or  => 
raise  List_Is_,Null; 
end  Set_Head; 

procedure  Swap_Tail  (Of..-TheJLjist  :  in  out  List; 

And_The_List  :  in  out  List)  is 
Tensor ary_Node  :  List; 
begin 

if  Andjrhe_List  =  Null^List  then 

if  Heap (Of_The_List.The_Head)  .Next  /=  Null^List  then 
Tertporary_Node  Heap(Of  jrhe_List  .The_Head)  .Next; 

Heap ( Temper ary_Node . The_Head ) . Previ ous  : =  Nu 1 l_Lis  t ; 
Heap{Of_The_List .The^Head) .Next  :=  Null_List; 
AndLThe_List  :=  Tenporary_Node  ; 
end  if; 

elsif  Heap {And_The_List.The_Head) .Previous  =  Null_List  then 
if  Heap ( Of _The_List.The_Head)  .Next  /=  Null_List  then 
Teit5)orary_^ode  :=  Heap(Of_„The_List .The_Head)  .Next; 
Heap (Tenporary^Node.The^Head)  .Previous  :=  Null_List; 
Heap (Of_The_List.The_Head) .Next  :=  And_The_List; 

Heap  ( And_The_Lis  t .  The_Head )  .  Previous  :  =  Of _The_Lis t ; 
And_The„List  :=  Teitpor  ary  JNode  ; 

else 

Heap ( And_The_Lis t . The„Head) . Previous  : =  Of_The_List ; 
Heap (Of_The_List.The_Head) -Next  :=  And^The_List ; 
And_The__List  Null_List; 
end  if; 

else 

raise  Not_jAt_Head; 
end  if; 
exception 

when  Constraint_Error  => 
raise  List_Is_Null ; 
end  Swap_Tail; 

—  modified  by  Vincent  Hong  and  Tuan  Nguyen 

date:  9  April  1995 

adding  procedures  to  replace  functions 

procedure  ls_Egual  (Left  :  in  List; 

Right  :  in  List; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is_Egual  (Left, Right) ; 
end  Is_Equal; 

procedure  Length_Of  (The_List  :  in  List; 

Result  :  out  Natural)  is 

begin 

Result  Length_Of  (The_List) ; 

end  Length_Of; 

procedure  ls_Null  (The_List  :  in  List; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is_Null  (The_List); 

end  Is^Null; 

procedure  Head_Of  (The^List  :  in  List; 

Result  :  out  Item)  is 

begin 

Result  ;=  Head_Of  (The_List); 

end  Head_Of; 

procedure  Tail_Of  {The_List  ;  in  List; 

Result  :  out  List)  is 

begin 

Result  :=  Tail^Of  (The^List) ; 

end  Tail_Of; 

procedure  Predecessor_Of  (The__List  :  in  List; 

Result  :  out  List)  is 

begin 

Result  :=  Predecessor_Of  (The_List) ; 
end  Predecessor_Of ; 

—  end  of  modification 

function  Is_Egual  (Left  :  in  List; 

Right  :  in  List)  return  Boolean  xs 
Left_Index  :  List  :=  Left; 

Right_Index  :  List  :=  Right; 
begin 

while  Left_lndex  /-  Null_List  loop 

if  Heap  ( Le f t_Index . The_Head )  . The_I t em  / = 
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Heap{Right_lndex.The_Head)  .The_Item  then 
return  False; 
end  if; 

Left_Index  :=  Heap {Left_Index.The_Head) .Next; 
Right_Index  :  =  Heap  ( Right_Index .  The_Head )  -  Next ; 
end  loop; 

return  (Right_Index  =  Null_List) ; 
exception 

when  Constraint_Error  => 
return  False; 
end  Is_Equal; 

function  Length^Of  (The^List  ;  in  List)  return  Natural  is 
Count  :  Natural  :=  0; 

Index  ;  List  ;=  The_List; 

begin 

while  Index  /=  Null_List  loop 
Count  Count  +  1; 

Index  :=  Heap ( Index. The_Head) .Next; 
end  loop; 
return  Count; 
end  Length_Of; 

function  IsJTull  {The_List  :  in  List)  return  Boolean  is 
begin 

return  {The_List  ~  Null_List) ; 
end  Is^ull; 

function  Head_Of  (The^List  ;  in  List)  return  Item  is 
begin 


return  Heap (The^Lis t . The_Read) . The^Item; 
exception 

when  Constraint_Error  => 
raise  List_Is_Null; 
end  HeacLOf; 

function  Tail^Of  (TheJList  :  in  List)  return  List  is 
begin 

return  Heap (The_List . The^Head) .Next ; 
exception 

when  Cons t rain t_Err or  => 
raise  List_Is_^ull; 
end  Tail_Of; 

function  Predecessor_Of  (The^List  :  in  List)  return  List  is 
begin 

return  Heap  (The^List . The^ead)  .  Previous ; 
exception 

when  Constraint^Error  => 

raise  List_Is_Null;  , 

end  Predecessor_Of ; 

i?egin 

Free_List .The^Head  :=  1; 
for  Index  in  1  . .  {The_Si2e  -  1)  loop 
Heap (Index) .Previous  :=  Null_List; 

Heap (Index) .Next  :=  List' (The_Head  =>  (Index  +  1)); 
end  loop; 

Heap (The_Size) .Next  :=  Null_List; 
end  List_Double_BoundedJManaged; 
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UST  DOUBLE  BOUNDED  MANAGED 


PSDL 


TYPE  List_DOTable_Bo\mdecLJlanaged 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

FroiiuThe_List  :  List, 

To_The_List  :  List 
OUTPUT 

To_The_List  ;  List 
EXCEPTIONS 

Overflow,  List_Is_Null,  Not^t_Head 

ENU 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_List  :  List 
OUTPUT 

The_List  :  List 
EXCEPTIONS 

Overflow,  List_Is^ull,  Not^t_Head 

END 

OPERATOR  Construct 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

AndLThe_List  ;  List 
OUTPUT 

And_The_List  :  List 
EXCEPTIONS 

Overflow,  List^Is_Null,  Not_At^Head 

END 

OPERATOR  Set^ead 
SPECIFICATION 
INPUT 

Of_The_List  :  List, 

To_The_Item  :  Item 
OUTPUT 

Of_The_List  :  List 
EXCEPTIONS 

Overflow,  List_Is_JJull ,  Not_At_Head 

END 

OPERATOR  Swap_Tail 
SPECIFICATION 
INPUT 

Of_The_List  :  List, 

And_The_List  :  List 
OUTPUT 

Of_The_List  :  List , 

And_15ie_List  :  List 
EXCEPTIONS 

Overflow,  List_Is^Null,  Not^At_Head 

END 

OPERATOR  Is_Equal 
SPECIFICATION 
INPUT 


Left  :  List, 

Right  :  List 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  List_Is_Null,  Not_At_^ead 

END 

OPERATOR  Length^Of 

SPECIFICATION 

INPUT 

The^List  :  List 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  List_Is_Null,  Not_At_Head 

END 

OPERATOR  IS^Null 

SPECIFICATION 

INPUT 

The_List  ;  List 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  List_Is_Null,  Not_At_Head 

END 

OPERATOR  HeadLOf 

SPECIFICATION 

INPUT 

TheJList  :  List 
OUTPUT 

Result  :  Item 
EXCEPTIONS 

Overflow,  List_Is_JJull,  Not_Jvt_Head 

END 

OPERATOR  Tail^Of 

SPECIFICATION 

INPUT 

The_List  :  List 
OUTPUT 

Result  :  List 
EXCEPTIONS 

Overflow,  List_Is_Null,  Not_At_Head 

END 

OPERATOR  Predecessor_Of 

SPECIFICATION 

INPUT 

The_List  :  List 
OUTPUT 

Result  ;  List 
EXCEPTIONS 

Overflow,  List_ls^ull,  Not^t_Head 

END 

END 

IMPLEMENTATION  ADA  List_Double_Bounded_Managed 
END 


78 


UST  DOUBLE  UNBOUNDED  MANAGED 


ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 
package  List_Doiable_UnboundedL^anaged  is 


type  List 

is  private 

Null_List 

:  constant 

List; 

procedure 

Copy 

( From_The_Lis  t 

:  in 

List; 

To_The_List 

:  in 

out 

List) 

procedure 

Clear 

(The_List 

:  in 

out 

List) 

procedure 

Construct 

(The_Item 

:  in 

Item; 

And_The__List 

:  in 

out 

List) 

procedure 

Set_Head 

(Of_The_List 

:  in 

out 

List; 

To_The_Item 

:  in 

Item) 

procedure 

Swap_Tail 

{Of_The_List 

:  in 

out 

List; 

And_The_List 

:  in 

out 

List) 

Result 

procedure  HeacLOf  {The^List 

Result 

procedure  Tail_Of  {The^List 

Result 

procedure  Predecessor_Of  (The_List 
Result 


end  of  modification 


function  Is_Equal 

function  Length^Of 
function  Is^Null 
fxmction  Head_Of 
function  Tail_Of 
function  Predecessor_Of 


(Left 

Right 

(The^List 

(The_List 

(The_List 

(The^List 

(The_List 


:  out  Boolean) ; 
:  in  List; 

:  out  Item) ; 

:  in  List; 

:  out  List) ; 

;  in  List; 

:  out  List) ; 


in  List; 

in  List)  return  Boolean; 
in  List)  return  Natural; 
in  List)  return  Boolean; 
in  List)  return  Item; 
in  List)  return  List; 
in  List)  return  List; 


—  modified  Vincent  Hong  and  Tuan  Nguyen 

—  date:  9  April  1995 

—  adding  procedures  to  replace  fxinctions 


Overflow  :  exception; 
List«Is_Null  :  exception; 
Not_At_Head  :  exception; 


procedure  Is_Equal 

procedure  Length^Of 
procedure  IsJtJull 


(Left 

Right 

Result 

(The_List 

Result 

(The_List 


in  List; 
in  List; 
out  Boolean) ; 
in  List; 
out  Natural) ; 
in  List; 


private 

type  Node; 

type  List  is  access  Node; 

Null_List  :  constaint  List  :=  null; 
end  List_Dotible_Unbounded_Jlanaged; 
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LIST  DOUBLE  UNBOUNDED  MANAGED 


ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

-Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3)  (ii) 
--of  the  rights  in  Technical  Data  and  Conputer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

with  Storage_Manager_Sequential ; 

package  body  List_Double_UnboundedLManaged  is 

type  Node  is 
record 

Previous  :  List; 

The_Item  :  I tern; 

Next  :  List; 
end  record; 

procedure  Free  (TheJIode  ;  in  out  Node)  is 
begin 

The_Node . Previous  :=  null; 
end  Free; 

procedure  Set__Next  {The_JJode  ;  in  out  Node; 

To_Next  :  in  List)  is 

begin 

The_Node .  Next  :  =  To_Next  ; 
end  Set_Ne3ct; 

function  Next_Of  {The_Node  :  in  Node)  return  List  is 
begin 

return  The^Node . Next ; 
end  Next_Of; 

package  Node_Manager  is  new  Storage^anager_Sequential 

(Item  =>  Node, 

Pointer  =>  List, 

Free  =>  Free , 

Set_Pointer  =>  Set_Next, 

Pointer_Of  =>  Next_Of ) ; 

procedure  Copy  {From_The_List  :  in  List; 

To_The_List  ;  in  out  List)  is 
From_lndex  :  List  :=  Prom_„The_List  ; 

To_Index  :  List; 
begin 

Node.JIanager .  Free  ( To_The_Li  s  t )  ; 
if  FroitL.The_List  /-  null  then 

To_The_List  :=  Node_jManager.New_Item; 
To_The_List.The_Item  :=  FroiTuIndex.The_Item; 
To_Index  :=  To_The_List; 

From_Index  :=  FronuIndex.Next; 
while  Froia_Index  /=  null  loop 

To_Index .  Next  Node_Manager  ,New_Item; 

To_Index .  Next .  Pr evi  ous  :  =  To_Index ; 
To_Index  :=  To_Index.Next; 
To_Index.The_Itein  :=  Froin_Index.The_Item; 
Fronulndex  :=  From_Index.Next ; 
end  loop; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Copy; 

procedure  Clear  {The_List  :  in  out  List)  is 
begin 

Node_Manager . Free (The_List ) ; 
end  Clear; 

procedure  Construct  (The_Item  :  in  I tern, - 

And_The_List  :  in  out  List)  is 
TenporaryJJode  ;  List; 
begin 

if  And_The_List  =  null  then 

And_The_List  :=  Node_Jlanager.New_Item; 
AncLThe_List.The_Item  :=  The_Item; 
elsif  And_The_List. Previous  =  null  then 

Teinporary_Node  :=  Node_Manager  .New_Item; 

Tenpor ary^Node .  The_l  tern  ;=  The_Item; 
Tenporary_Node.Next  ;=  AncLThe_List ; 
And_The_List .  Previous  :=  Teirporary^ode  ; 
And^The^List  :=  Temper ary_Node  ; 

else 

raise  Not_^t_Head; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Construct; 

procedure  SetJHead  {Of_The_List  :  in  out  List; 


To_The_Item  :  in  Item)  is 

begin 

Of_The_List .The^Item  :=  To_The_Item; 
exception 

when  Constraint_Error  => 
raise  List_Is^ull; 
end  Set_Head; 

procedure  Swap__Tail  {Of„The_List  :  in  out  List; 

And_The_List  :  in  out  List)  is 
Tertporary_JJode  :  List; 
begin 

if  And_The_List  =  null  then 

if  Of_The_List .Next  /=  null  then 

TeitporaryJNode  :=  Of_The_List .Next; 
Teitporary^Node . Previous  :=  null; 
Of_The_List .Next  :=  null; 

AndLThe_List  :=  TenporaryJNode; 
end  if; 

elsif  And_The_List .Previous  =  null  then 
if  Of_The_List.Next  /=  null  then 

Ten:53orary_Node  :=  Of_The__List.Next; 
Of_The_List .Next. Previous  :=  null; 
Of_The_List .Next  :=  And_The_List; 
AncLThe_List . Previous  :=  Of_The_List; 
And_The_List  :=  Teinporary_Node  ; 

else 

And_The_List .Previous  :=  Of_The_List; 

Of _The_Lis  t . Next  : =  And_The_Li s t ; 
AndLThe_List  : =  null ; 
end  if; 

else 

raise  Not_At_Head; 
end  if; 
exception 

when  Constraint^Error  => 
raise  List^Is JJull ; 
end  Swap_Tail; 


modified  by  Vincent  Hong  and  Tuan  Nguyen 
date:  9  April  1995 

adding  procedures  to  replace  functions 


procedure  Is_Equal 


begin 

Result  :=  Is_Equal 
end  Is^Equal; 

procedure  Length_Of 

begin 

Result  :=  Length_Of 
end  LengthjOf; 

procedure  IsJJull 

begin 

Result  :=  Is_Null 
end  Is_Null; 

procedure  Head_Of 

begin 

Result  i-  Head_Of 
end  Head_Of; 

procedure  Tail^Of 

begin 

Result  : =  Tail_Of 
end  Tail_Of; 


(Left  :  in  List; 

Right  :  in  List; 

Result  :  out  Boolean)  is 

(Left, Right) ; 


(The_List  :  in  List; 

Result  :  out  Natural)  is 

(The_List) ; 


(The_List  :  in  List; 

Result  :  out  Boolean)  is 

{The_List)  ; 


(The^List  :  in  List; 
Result  :  out  Item)  is 

(The_List) ; 


(The_List  :  in  List; 
Result  ;  out  List)  is 

(The_List)  ; 


procedure  Predecessor_Of  (The_List  :  in  List; 

Result  :  out  List)  is 

begin 

Result  :=  Predecessor_Of  {The_List) ; 
end  Predecessor^Of ; 


end  of  modification 


function  Is_Equal  (Left  :  in  List; 

Right  ;  in  List)  return  Boolean  is 
Left_Index  :  List  :=  Left; 

Right_Index  :  List  ;=  Right; 
begin 

while  Left^Index  /=  null  loop 

if  Left_Index.The_Item  /=  Right_Index.The_Item  then 
return  False; 
end  if; 

Left^Index  :»  Lef t^Index.Next; 

Right_Index  High t_lndex. Next ; 
end  loop; 

return  {Right_lndex  =  null) ; 
exception 

when  Constraint_Error  => 
return  False; 
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end  Is_Eq:ual; 

function  Length_Of  (The_List  :  in  List)  return  Natural  is 
Count  :  Natural  :=  0; 

Index  :  List  :=  The_List; 

begin 

while  Index  /=  null  loop 
Coxint  :=  Count  +  1; 

Index  :=  Index. Next; 
end  loop; 
retxim  Count; 
end  Length^Of; 

function  IsJNull  (The_List  :  in  List)  return  Boolean  is 
begin 

return  (The_List  =  null) ; 
end  IsJNull; 

function  Head>.Of  (The^List  :  in  List)  return  Item  is 
begin 

return  The_List.The_Item; 
exception 


when  Constraint_Error  => 
raise  List_Is^ull; 
end  Head^Of; 

function  Tail_0f  (The_List  :  in  List)  return  List  is 
begin 

return  The_List.Next; 
exception 

when  Constraint_Error  => 
raise  List_Is_Null ; 
end  Tail^Of; 

fimction  Predecessor_Of  {The_List  :  in  List)  return  List  is 
begin 

return  The_List . Previous ; 
exception 

when  Constraint_Error  => 
raise  List_Is_Null ; 
end  Predecessor_Of ; 

end  List_Double_UnboxindedLManaged; 
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UST  DOUBLE  UNBOUNDED  MANAGED 


PSDL 


TYPE  List_Double_Unbounde<^Managed 
SPECIFICATION 
GENERIC 

Item  ;  PRIVATE^TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

Frorn_The_List  :  List, 

To_The_List  :  List 
OUTPUT 

To_The_List  :  List 
EXCEPTIONS 

Overflow,  List_Is_Null,  Not_AtJHead 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_List  :  List 
OUTPUT 

•Rie^List  :  List 
EXCEPTIONS 

Overflow ,  Lis t_I s JNul  1 ,  No t_A t_Head 

END 

OPERATOR  Construct 
SPECIFICATION 
INPUT 

The_Itein  :  Item, 

And_The_List  :  List 
OUTPUT 

AndLThe_List  :  List 
EXCEPTIONS 

Overflow,  List_IsJNull,  Not^t_Head 

END 

OPERATOR  Set_Head 
SPECIFICATION 
INPUT 

Of_The_List  :  List, 

To_The_Item  :  Item 
OUTPUT 

Of_The_List  :  List 
EXCEPTIONS 

Overflow,  List_Is_Null,  Not^t_Head 

END 

OPERATOR  Swap_Tail 
SPECIFICATION 
INPUT 

Of_The_List  :  List, 

And_The_List  :  List 
OUTPUT 

Of_The_List  ;  List, 

And_The_List  :  List 
EXCEPTIONS 

Overflow,  List_Is_Null,  Not_At_Read 

END 

OPERATOR  Is_Equal 
SPECIFICATION 
INPUT 


Left  :  List, 

Right  :  List 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  List_Is_Null,  Not_At_Head 

END 

OPERATOR  Length_Of 

SPECIFICATION 

INPUT 

The^List  :  List 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  List_Is_Null,  Not_At_Head 

END 

OPERATOR  Is_Null 

SPECIFICATION 

INPUT 

The_List  :  List 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  List_IsJNull,  Not^t^Head 

END 

OPERATOR  Heaci_Of 

SPECIFICATION 

INPUT 

The_List  :  List 
OUTPUT 

Result  :  Item 
EXCEPTIONS 

Overflow,  List_Is_Null,  Not^t_Head 

END 

OPERATOR  Tail_Of 

SPECIFICATION 

INPUT 

The_List  :  List 
OUTPUT 

Result  :  List 
EXCEPTIONS 

Overflow,  List_Is_Null,  Not_At_Head 

END 

OPERATOR  Predecessor_Of 

SPECIFICATION 

INPUT 

The_List  :  List 
OUTPUT 

Result  :  List 
EXCEPTIONS 

Overflow,  List_Is_Null,  Not_At_Head 

END 

END 

IMPLEMENTATION  ADA  List_Double_Unbounded_Managed 
END 
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LIST  DOUBLE  UNBOUNDED  UNMANAGED 


ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

package  List_Double_Unbounded^Uniiianaged  is 
type  List  is  private; 

Null_List  :  constant  List; 


Result  :  out  Boolean) 
procedure  Head_Of  {The_List  :  in  List; 

Result  :  out  Item) ; 

procedure  Tail_0£  {The_List  :  in  List; 

Result  :  out  List) ; 

procedure  Predecessor_Of  (The^List  :  in  List; 

Result  :  out  List) ; 


procedure 

procedure 

procedure 

procedure 

procedure 


Copy 

Clear 

Construct 

Set_Head 

Swap_Tail 


{ FroitL_The_Lis  t 
To_The_List 
(The_List 
(The_Item 
And_The_List 
(Of_The_List 
To_The_Item 
(Of„The_List 
And_The_List 


in  List; 
in  out  List) ; 
in  out  List) ; 
in  Item; 
in  out  List) ; 
in  out  List; 
in  Item)  ; 
in  out  List; 
in  out  List) ; 


end  of  modification 

function  Is_Equal 

f\inction  Length_Of 
function  Is^^Jull 
function  HeacSLOf 
function  Tail_Of 
function  Predecessor. 


(Left  :  in 

Right  :  in 
(The_List  :  in 
(The_List  :  in 
(The_List  :  in 
(The_List  :  in 
_Of  (The_List  :  in 


List; 

List)  return  Boolean; 
List)  return  Natural; 
List)  return  Boolean; 
List)  return  I tern; 
List)  return  List; 
List)  return  List; 


—  modified  by  Vincent  Hong  and  Tuan  Nguyen 

—  date:  9  i^ril  1995 

adding  procedures  to  replace  functions 


Overflow  :  exception; 
List_Is_Null  ;  exception; 
Not^tJHead  :  exception; 


procedure  Is_Equal 

procedure  Length_Of 
procedure  ls_Null 


(Left 

Right 

Result 

(The_List 

Result 

(The^List 


in  List; 
in  List; 
out  Boolean) ; 
in  List; 
out  Natural )  ; 
in  List; 


private 

type  Node; 

type  List  is  access  Node; 

Null_List  :  constant  List  :=  null; 
end  List_Double_Unbounded_Uninanaged; 
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LIST  DOUBLE  UNBOUNDED  UNMANAGED 


ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  N\iinber  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  siibdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Computer 

--  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

--  Wisard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body  List_Double_Unbounded_Uninanaged  is 


type  Node  is 
record 

Previous  :  List; 
The_Item  ;  Item; 
Next  :  List; 
end  record; 


procedure  Copy  {FroituThe_List  ;  in  List; 

To_The_List  :  in  out  List)  is 

Frortuindex  :  List  :=  FronuThe_List  ; 

To^Index  :  List ; 
begin 

if  Front_The_List  =  null  then 
To_The_List  null; 

else 

To_The_List  :=  new  Node M Previous  =>  null, 

~  ”  The_Item  =>  From_Index.The_Item, 

Next  =>  null); 

To_Index  ;=  To_The_List; 

Froitulndex  :=  Froin_Index.Next ; 
while  Froii\_Index  (-  null  loop 

To^Index.Next  :=  new  Node'  (Previous  =>  To_Index, 
The_Itein  => 

From_Index .  The_Item, 

Next  =>  null); 


To^Index  :=  To_Index-Next ; 
From_Index  ;  =  Froin_Index .  Next  ; 
end  loop; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Copy; 


procedure  Clear  (The_List  ;  in  out  List)  is 
begin 

The_List  : =  null ; 
end  Clear; 


procedure  Construct  (The_Item  :  in  Item; 

And^The_List  ;  in  out  List)  is 

begin 

if  And_The_List  =  null  then 

AncLThe_List  :=  new  Node ‘  ( Previous  =>  null, 

The_Item  =>  The_ltem, 

Next  =>  null) ; 

els if  And_The_List- Previous  =  null  then 

AncUThe_List  :=  new  Node*  (Previous  =>  null, 

The^Item  =>  The_Item, 

Next  =>  And_The_List)  ; 

And_The_List.  Next  .Previous  :=  And_The_j:ist  ; 

else 

raise  NoC_At_Head; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Construct; 

procedure  Set^Head  (Of_The_List  :  in  out  List; 

To_The_Item  :  in  Item)  is 

begin 

Of_The_List .The_Item  :=  To_The_Item; 
exception 

when  Cons train t_Err or  => 
raise  List_Is_^ull; 
end  SetJHead; 

procedure  Swap_Tail  {Of_The_List  :  in  out  List; 

And_The_List  :  in  out  List)  is 
TeirporaryJIode  :  List; 
begin 

if  And_The_List  =  null  then 

if  Of_The_List .Next  /=  null  then 

Temporary_Node  :=  Of_The_List.Next; 
Teir?5orary^ode. Previous  :=  null; 

Of_The_List .Next  : =  null ; 

AndJThe^List  :=  Teit^jor ary^Node  ; 
end  if; 

elsif  And_The_liist .Previous  =  null  then 
if  Of_ahe_List .Next  /=  null  then 

Temper  ary JMode  ;=  Of_The_List  .Next ; 


Teitporary_Node . Previous  :=  null; 

Of _The_Lis  t .  Next  :  =  And_The_Li  s  t ; 
AncLThe_List. Previous  ;=  Of_The_List; 
And_The_List  :=  Teinporary_Node ; 

else 

And_The_Lis t . Previous  : =  Of_The^List ; 
Of_The_Lis t . Next  :  =  And_The_Lis t  ; 
And_The_List  :=  null; 
end  if; 

else 

raise  Not^t_Head; 
end  if; 
exception 

when  Constraint_Error  => 
raise  List_Is_Null; 
end  Swap_Tail; 


modified  by  Vincent  Hong  cuid  Tuan  Nguyen 
date;  9  April  1995 

adding  procedures  to  replace  functions 

procedure  Is^Egual  (Left  ;  in  List; 

Right  :  in  List; 

Result  :  out  Boolean)  is 

begin 

Result  Is^Equal  (Left, Right) ; 
end  Is_Equal; 


procedure  Length_0f  (The_List  :  in  List; 

Result  :  out  Natural)  is 

begin 

Result  : =  Leng t h_0 f  ( The_Lis t ) ; 

end  Length^Of; 


procedure  Is_Null  (The_List  :  in  List; 

Result  :  out  Boolean)  is 

begin 

Result  ;=  IsJMull  (The^List) ; 

end  IsJtJull; 


procedure  Head_Of  (The^List  ;  in  List; 

Result  :  out  Item)  is 

begin 

Result  :=  Head^Of  (The_List) ; 

end  Head_0f; 


procedure  Tail_Of  (The_List  :  in  List; 

Result  :  out  List)  is 

begin 

Result  ;=  Tail_0f  (The_List) ; 

end  Tail_Of; 


procedure  Predecessor_Of  (The_List  ;  in  List; 

Result  :  out  List)  is 

begin 

Result  :=  Predecessor_Of  (The_List) ; 
end  Predecessor_Of ; 


end  of  modification 


function  Is_Equal  (Left  :  in  List; 

Right  :  in  List)  return  Boolean  is 
Left^Index  ;  List  ;=  Left; 

Right_Index  ;  List  :=  Right; 
begin 

while  Left_Index  /=  null  loop 

if  Left_Index.Tbe_Item  /=  Right_Index . The_Item  then 
return  False; 
end  if; 

Left_Index  :=  Left_Index.Next ; 

Right_Index  :=  Right_Index.Next ; 
end  loop; 

return  (Right_Index  =  null) ; 
exception 

when  Constraint_Error  => 
return  False; 
end  Is_Equal; 

function  Length_Of  (The_List  :  in  List)  return  Natural  is 
Coxant  :  Natural  :=  0; 

Index  :  List  :=  The_List; 

begin 

while  Index  /=  null  loop 
Count  ;=  Count  +  1; 

Index  :=  Index. Next; 
end  loop; 
return  Count; 
end  LengthjOf ; 

function  Is_Null  (The^List  :  in  List)  return  Boolean  is 
begin 

return  (The^List  =  null) ; 
end  Is^Null; 

function  Head_Of  (The_List  :  in  List)  return  Item  is 
begin 

return  The_List-The_Item; 
exception 
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when  Constraint^Error  => 
raise  List_Is_^Iull; 
end  HeadLOf; 

function  Tail_Of  (The_List  :  in  List)  return  List  is 
begin 

return  The_List .Next ; 
exception 

when  Constraint_Error  => 
raise  List_Is_Null; 
end  Tail_Of; 


function  Predecessor_Of  (The_List  :  in  List)  retxim  List  is 
begin 

return  The_List . Previous ; 
exception 

when  Constraint_Error  => 
raise  List_Is_Null; 
end  Predecessor^Of ; 

end  List_Double_Unbo\mded_Uninanaged; 
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LIST  DOUBLE  UNBOUNDED  UNMANAGED 


PSDL 


TYPE  List_Do\able_Unbo\mded_Unnianaged. 

SPECIFICATION 

GENERIC 

Item  :  PRIVATE^TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

From_The_List  :  List, 

To_The_List  :  List 
OUTPUT 

To_The_List  :  List 
' EXCEPTIONS 

Overflow,  List_Is_Null,  Not_At^Head 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The^List  :  List 
OUTPUT 

The_List  :  List 
EXCEPTIONS 

Overflow,  List_Is_Null,  Not_At_Head 

END 

OPERATOR  Construct 
SPECIFICATION 
INPUT 

The_Itein  :  Item, 

And_The_List  :  List 
OUTPUT 

And_The_List  ;  List 
EXCEPTIONS 

Overflow,  List^Is_Null,  NotJ^t^Head 

END 

OPERATOR  Set_Head 
SPECIFICATION 
INPUT 

Of_The_List  ;  List, 

To_The_Item  :  Item 
OUTPUT 

Of_The_List  ;  List 
EXCEPTIONS 

Overflow,  List_Is_Null,  Not^t^Head 

END 

OPERATOR  Swap_Tail 
SPECIFICATION 
INPUT 

Of_The_List  :  List, 

And_The_List  :  List 
OUTPUT 

Of_The_List  ;  List, 

And_The_List  :  List 
EXCEPTIONS 

Overflow,  List_Is_Null,  Not_At_Head 

END 

OPERATOR  Is_Egual 
SPECIFICATION 
INPUT 


Left  :  List, 

Right  :  List 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  List_Is_Null,  Not^t^Head 

END 

OPERATOR  Length_Of 

SPECIFICATION 

INPUT 

The_List  :  List 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  List_Is_Null,  Not_At_Head 

END 

OPERATOR  Is_Null 

SPECIFICATION 

INPUT 

The_List  :  List 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  List_Is_Null,  Not_At_Head 

END 

OPERATOR  Head^Of 

SPECIFICATION 

INPUT 

TheJUist  :  List 
OUTPUT 

Result  :  Item 
EXCEPTIONS 

Overflow,  List_Is_Null,  Not^t_Head 

END 

OPERATOR  Tail_Of 

SPECIFICATION 

INPUT 

The_List  ;  List 
OUTPUT 

Result  :  List 
EXCEPTIONS 

Overflow,  List_Is_Null,  Not_At_Head 

END 

OPERATOR  Predecessor_Of 

SPECIFICATION 

INPUT 

The_List  :  List 
OUTPUT 

Result  ;  List 
EXCEPTIONS 

Overflow,  List_Is_Null,  Not_At_Head 

END 

END 

IMPLEMENTATION  ADA  List_Douhle_Unbounded_Uninanaged 
END 
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LIST  SINGLE  BOUNDED  MANAGED 


ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

The_Size  :  in  Positive; 
package  List_Single_BoundedJManaged  is 

type  List  is  private; 

Null_List  ;  constant  List; 

procedure  Copy  (Fron\_The_List  :  in  List; 

To_The_List  ;  in  out  List) ; 

procedure  Clear  {Tlie_List  :  in  out  List)  ; 

procedure  Construct  (The^Item  :  in  Item; 

Andjrhe_List  :  in  out  List) ; 

procedure  Set_Head  (Of_The_List  :  in  out  List; 

To_The_Item  ;  in  Item)  ; 

procedure  Swap_Tail  (Of_The_List  :  in  out  List; 

And_The_List  :  in  out  List) ; 

—  modified  by  Vincent  Hong  and  Tuan  Nguyen 

—  date:  9  April  1995 

—  adding  procedures  to  replace  functions 

procedure  Is_Equal  (Left  :  in  List; 

Right  :  in  List; 

Result  :  out  Boolean) ; 

(The_List  :  in  List; 


Result  :  out  Natural ) ; 
procedure  Is_Null  (The^List  :  in  List; 

Result  :  out  Boolean) ; 
procedure  Head_Of  {The_List  ;  in  List; 

Result  :  out  Item) ; 

procedure  Tail_Of  {The_List  :  in  List; 

Result  :  out  List); 

—  end  of  modification 

function  Is_Equal  (Left  :  in  List; 

Right  :  in  List)  return  Boolean; 
fxanction  Length_Of  (The_List  :  in  List)  return  Natural; 

function  IsJNull  (The__List  :  in  List)  return  Boolean; 

ftinction  Head_Of  (The_List  :  in  List)  return  Item; 

f\jnction  Tail^Of  {The_List  :  in  List)  return  List; 

Overflow  :  exception; 

List_Is^ull  :  exception; 

private 

type  List  is 
record 

The__Head  ;  Natural  :=  0; 
end  record; 

Null_List  :  constant  List  ;=  List ' (The_Head  =>  0) ; 
end  List_Single_Bounded^Managed; 


procedure  Length_Of 


LIST  SINGLE  BOUNDED  MANAGED 


ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  GracSy  Booch 

—  All  Rights  Reserved 

—  Serial  Nuniber  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

--  restrictions  as  set  forth  in  subdivision  (b)  (3)  {ii) 

—  of  the  rights  in  Technical  Data  and  Coj^nputer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer; 

--  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body  List_Single^ounded^anaged  is 

type  Node  is 
record 

The_Item  :  Item; 

Next  :  List; 

end  record; 

Heap  :  array (Positive  range  1  . .  The_Size)  of  Node; 
Free_List  :  List; 

procedure  Free  (The_List  :  in  out  List)  is 
Tenporary_Node  :  List; 
begin 

while  The^List  f-  Null_List  loop 
Tenporary_Node  :=  The_List; 

The_List  ;=  Heap (The_.List.The_Head)  .Next; 

Heap (TeitporaryJNode . The__Head)  .Next  :=  Free_List; 
Free_List  :=  Tenporary_Node ; 
end  loop; 
end  Free; 

fxmction  New_Item  return  List  is 
Temporary JtJode  :  List; 
begin 

if  Free_List  =  Null_List  then 
raise  Storage^Error ; 

else 

Temper ary^Node  :=  Free_List; 

Free-List  :=  H€ap(Free_List.The_Head).Next; 

Heap  (TenporaryJJode .  The_Head)  .Next  :=  Null_List; 
return  Teitpor ary_Node  ; 
end  if; 
end  New_Item; 

procedure  Copy  (Froin_The_List  :  in  List; 

To_The_List  :  in  out  List)  is 
From_Index  :  List  :=  FronL.The_List ; 

To^Index  :  List ; 
begin 

Free(To_The_List) ; 

if  Fromjrhe_List  /=  Null_List  then 
To__The_Lis  t  :  =  New_I  tern  ; 

Heap  (To„The_Lis t .  The_Head )  .  The_I tern  :  = 

Heap  ( From_Index .  The_Head )  .  The_I  tern  ; 

To_Index  :=  To_The_List; 

Fr onulndex  :  =  Heap  ( From_Index .  The_Head )  .  Next ; 
while  From_Index  /=  Null^List  loop 

Heap(To_Index.The_Head) .Next  :=  New_Item; 
To_Index  :  =  Heap  ( To_Index .  The_Head )  .  Next ; 
Heap  ( To_Index .  The^ead)  .  The_I tern  ;  = 

Heap  ( From_Index .  The_Head)  .  The_I  tern ; 
From^Index  =  Heap  { Fr om_Indcx .  The^ead )  .  Next ; 
end  loop; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Copy; 

procedure  Clear  {The_List  :  in  out  List)  is 
begin 

Free{The_List) ; 
end  Clear; 

procedure  Construct  (The_Item  :  in  Item; 

And_The_List  :  in  out  List)  is 
Tenporary^Node  :  List; 
begin 

Teiiporary_Node  :=  New_Item; 

Heap{Teinporary__Node  .The__Head)  .The_Item  The_Item; 

Heap  { Temporary_Node ,  The_Head)  .  Next  ;  =  And^The_Lis t ; 
An<^The_List  :=  Temper ary^Node ; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Construct; 

procedure  Set_Head  (Of_The_List  ;  in  out  List; 

To_The_Item  :  in  Item)  is 

Heap  ( Of _The_Lis t .  The_Head )  .  The_I tern  :  =  To_The_I t em ; 
exception 


when  Constraint_Error  => 
raise  List_Is_Null; 
end  Set_Head; 

procedure  Swap_Tail  (Of_The_List  :  in  out  List; 

And_The_List  :  in  out  List)  is 
Temporary  JtJode  :  List; 
begin 

Tenpor ary_Node  :  Heap  ( Of _The_L  i  s  t .  The_Head )  .  Next  ; 
Heap  ( Of _The_Lis t .  The_Head)  .  Next  :  =  And_The_List  ; 
AndLThe_List  :=  Temper ary_JJode ; 
exception 

when  Constraint_Error  => 
raise  List_Is_Null; 
end  Swap_Tail; 

modified  by  Vincent  Hong  and  Tuan  Nguyen 
date:  9  April  1995 

adding  procedures  to  replace  functions 

procedure  Is^Equal  (Left  ;  in  List; 

Right  :  in  List; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is_Equal  (Left, Right) ; 
end  Is_Egual; 

procedure  Length_Of  {The_List  :  in  List; 

Result  :  out  Natural)  is 

begin 

Result  ;=  Length_Of  (The_List) ; 

end  Length^Of; 

procedure  IsJIull  (The_List  :  in  List; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is^Null  {The_List) ; 

end  Is_JJull; 

procedure  HeacLOf 

begin 

Result  ;=  HeadJOf 
end  Head_Of,- 

procedure  Tail_Of  (The^List  :  in  List; 

Result  ;  out  List)  is 

begin 

Result  :=  Tail_Of  (The^List) ; 

end  Tail_0f; 

end  of  modification 

function  Is^Equal  (Left  :  in  List; 

Right  :  in  List)  return  Boolean  is 
Left_Index  :  List  :=  Left; 

Right_Index  :  List  :=  Right; 
begin 

while  Left_Index  /=  Null_List  loop 

if  Heap (Lef t_Index.The_Head) .The_Item  /= 
Heap(Right_Index.The_Head) .The_Item  then 
return  False; 
end  if; 

Left_Index  :=  Heap{Left_Index.The_Head) .Next; 
Right^Index  :=  Heap(Right_Index.The_Head} .Next ; 
end  loop; 

return  (Right^Index  =  Null_List) ; 
exception 

when  Cons train t_Error  => 
return  False; 
end  Is_Equal; 

function  Length^Of  (The_List  :  in  List)  return  Natural  is 
Count  ;  Natural  :=  0; 

Index  ;  List  ;=  The_List; 

begin 

while  Index  /=  Null_List  loop 
Coiint  ;=  Count  +  1; 

Index  : =  Heap ( Index . The^Head ) . Next ; 
end  loop; 
return  Count; 
end  Length_Of; 

function  Is^ull  (The^List  :  in  List)  return  Boolean  is 
begin 

return  (The_List  =  Null_List) ; 
end  Is^Null; 

function  Head..Of  (The_List  :  in  List)  return  Item  is 
begin 

return  Heap(The_List.The_Head) .The_Item; 
exception 

when  Constraint_Error  => 
raise  List_Is_Null; 
end  HeacLOf; 

fxmction  Tail_0f  (The_List  :  in  List)  return  List  is 
begin 


(The_List  :  in  List; 
Result  :  out  Item)  is 

(The_List) ; 
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retiim  Heap(The_List,The_Head)  .Next; 
exception 

when  Constraint_Error  *> 
raise  List_Is_Null; 
end  Tail^Of; 

begin 


Free_List .The^Head  ;=  1; 

for  Index  in  1  . .  (The_Size  -  1}  loop 

Heap (Index) .Next  :=  List* (The^Head  «>  (Index  +  1) ) 
end  loop; 

Heap (The_Size) .Next  :»  Null_List; 
end  List_Single_Bounded_Managed; 
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LIST  SINGLE  BOUNDED  MANAGED 


PSDL 


TYPE  List_Single_Bovinded_Managed 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

From_The_List  :  List, 

To_The_List  :  List 
OUTPUT 

To_The_List  :  List 
EXCEPTIONS 

Overflow,  List_Is_Null 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_List  :  List 
OUTPUT 

The_List  :  List 
EXCEPTIONS 

Overflow,  List_Is„Null 

END 

OPERATOR  Construct 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

AncLThe_List  :  List 
OUTPUT 

And_The__List  :  List 
EXCEPTIONS 

Overflow,  List_IsJJull 

END 

OPERATOR  Set^Head 
SPECIFICATION 
INPUT 

Of_The_List  :  List, 

To_The_I  tern  :  I  tern 
OUTPUT 

Of_The_List  :  List 
EXCEPTIONS 

Overflow,  List_Is_Null 

END 

OPERATOR  Swap_Tail 
SPECIFICATION 
INPUT 

Of_The_List  :  List, 

AncLThe_List  :  List 
OUTPUT 

Of_The_List  :  List, 

Aiid_The_List  :  List 
EXCEPTIONS 

Overflow,  List_Is_Null 


END 

OPERATOR  Is_Equal 

SPECIFICATION 

INPUT 

Left  :  List, 

Right  ;  List 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  List_Is_Null 

END 

OPERATOR  Length_Of 

SPECIFICATION 

INPUT 

The_List  :  List 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  List_Is_Null 

END 

OPERATOR  IS_Null 

SPECIFICATION 

INPUT 

The_List  :  List 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  List_Is_Null 

END 

OPERATOR  Head_Of 

SPECIFICATION 

INPUT 

The__Li St  :  List 
OUTPUT 

Result  ;  Item 
EXCEPTIONS 

Overflow,  List_Is_Null 

END 

OPERATOR  Tail_Of 

SPECIFICATION 

INPUT 

The_List  :  List 
OUTPUT 

Result  :  List 
EXCEPTIONS 

Overflow,  List_Is_Null 

END 

END 

IMPLEMENTATION  ADA  List_Single_Boimded_Managed 
END 
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UST  SINGLE  UNBOUNDED  MANAGED 


ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 
package  List_Single_UriboundedJlanaged  is 

type  List  is  private; 

NullJjist  :  constant  List; 


procedure  IsJIull 
procedure  Head__Of 
procedure  Tail_Of 


Result 

(The_List 

Result 

(The_List 

Result 

(The_List 

Result 


out  Natural) ; 
in  List; 
out  Boolean) ; 
in  List; 
out  Item)  ; 
in  List; 
out  List) ; 


procedure 

procedure 

procedure 

procedure 

procedure 


Copy 

Clear 

Construct 

Set_Head 

SwapJTail 


{ FronL.The_Lis  t 
To„The_List 
{The_List 
{The_Item 
And_The_Lis  t 
(Of_The_List 
To_The_Item 
{Of_The_List 
And_The_List 


in  List; 
in  out  List) ; 
in  out  List) ; 
in  I  tern; 
in  out  List) ; 
in  out  List; 
in  Item) ; 
in  out  List; 
in  out  List) ; 


—  modified  by  Vincent  Hong  and  Tuan  Nguyen 

—  date:  9  April  1995 

—  adding  procedures  to  replace  functions 


procedure  Is_Equal 
procedure  Length^Of 


(Left 

Right 

Result 

(The_List 


in  List; 
in  List; 
out  Boolean) ; 
in  List; 


end  of  modification 


function  Is_Equal  (Left 
Right 

function  Length_Of  (The_List 
function  IsJJull  (The_List 
function  Head_Of  (The_List 
function  Tail_Of  (The_List 


in  List; 

in  List)  return  Boolean; 
in  List)  return  Natural; 
in  List)  return  Boolean; 
in  List)  return  Item; 
in  List)  return  List; 


Overflow  :  exception; 
List_Is_Null  :  exception; 

private 

type  Node; 

type  List  is  access  Node; 
Null_List  :  const2int  List  ;=  null; 
end  List_Single_UrLboundedJHanaged; 
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LIST  SINGLE  UNBOUNDED  MANAGED 


ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

•Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Computer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  {1-303-987-1874) 

with  Storage_Manager_Sequential; 

package  body  List_Single_Unbounded_McUiaged  is 

type  Node  is 
record 

The_Item  :  Item; 

Next  :  List; 
end  record; 

procedure  Free  {The_Node  :  in  out  Node)  is 
begin 

null  ; 
end  Free; 

procedure  Set^Next  (The_Node  :  in  out  Node; 

To^Next  :  in  List)  is 

begin 

The_Node  .Next  :=  To_Next; 
end  Set_Next; 

function  Next_Of  (The_Node  :  in  Node)  return  List  is 
begin 

return  The^ode.Next ; 
end  Next_Of; 

package  Node_Manager  is  new  Storage_Jlanager_Sequential 

(Item  ->  Node, 

Pointer  ->  List, 

Free  =>  Free, 

Set_Pointer  =>  SetJiJext, 

Pointer_0£  =>  Next^Of )  ; 

procedure  Copy  (Front.The_List  :  in  List; 

To_The_List  :  in  out  List)  is 
Front.Index  :  List  :=  From_The_List  ; 

To_Index  :  List  ,- 
begin 

Node_Manager . Free ( To_The_Lis t ) ; 
if  From_The_List  /=  null  then 

To_The_List  :=  NodeJManager.New_Item; 
To_The_List.The_Item  ;=  From_Index.The_Item; 
To_Index  :=  To_The_List; 

From_Index  :=  Fron\_Index.Next; 
while  From_Index  /=  null  loop 

To_Index.Next  :=  Node_^anager .New_Item; 
To_Index  :=  To_Index.Next; 

To_Index.The_It€m  ;=  FroituIiidex.The_Item; 
From_Index  :=  FronuIndex.Next; 
end  loop; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Copy; 

procedure  Clear  (The_List  :  in  out  List)  is 
begin 

Node  ^Manager . Free ( The_Lis t ) ; 
end  Clear; 

procedure  Construct  (The^Item  :  in  Item; 

And_The_List  :  in  out  List)  is 
Tenporary_JIode  :  List; 
begin 

Tenporary_Node  Node_Manager  .New_Item; 

Temper ary_JNode .  The^I tern  ;  =  The_I tern ; 

Temporary JJode .  Next  :  =  And_The_Lis  t ; 

And^The_List  :=  Tenporary_Node ; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Construct; 

procedure  Set^Head  (Of_The_List  :  in  out  List; 

To_The_Item  :  in  Item)  is 

begin 

Of_The_List .The_Item  :=  To_Th€_Item; 
exception 

when  Constraint_Error  => 
raise  List_Is_JIull; 
end  Set_Head; 

procedure  Swap_Tail  {Of_The_List  :  in  out  List; 

And_The_List  :  in  out  List)  is 


Temporary JJode  :  List; 
begin 

Tenporary_Node  :  =  Of_The_Lis t .  Next ; 

Of_The_List .Next  ;=  And_The_List ; 

And_The_List  :=  Tenporary_Node ; 
exception 

when  Constraint_Error  => 
raise  List_Is„Null ; 
end  Swap_Tail; 

—  modified  by  Vincent  Hong  and  Tuan  Nguyen 

date:  9  April  1995 

—  adding  procedures  to  replace  f\anctions 

procedure  Is_Equal  (Left  :  in  List; 

Right  :  in  List; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is_Egual  (Left, Right ) ; 
end  Is_Equal; 

procedure  Length^Of  (The_List  :  in  List; 

Result  :  out  Natural)  is 

begin 

Result  :=  Length^Of  (The_List) ; 

end  Length_Of; 

procedure  Is_Null  (The„List  :  in  List; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is_Null  (The^List); 

end  Is_Null; 

procedure  Head_Of  {The_List  :  in  List; 

Result  :  out  Item)  is 

begin 

Result  :=  Head^Of  (The_List) ; 

end  Head_Of; 

procedure  Tail^Of  (The_List  :  in  List; 

Result  :  out  List)  is 

begin 

Result  : =  Tai 1_0 f  ( The_Li s  t ) ; 

end  Tail_Of; 

—  end  of  modification 

f\mction  Is_Egual  (Left  :  in  List; 

Right  :  in  List)  return  Boolean  is 
Left_Index  :  List  :=  Left; 

Right_Index  :  List  :=  Right; 
begin 

while  Left_Index  /=  null  loop 

if  Left_Index.The_Item  /=  Right_Index.The_Item  then 
return  False; 
end  if; 

Left_Index  Left_Index.Next ; 

Right^Index  ;=  Right_Index.Next ; 
end  loop; 

return  (Right_Index  =  null) ; 
exception 

when  Constraint_Error  => 
return  False; 
end  Is^Equal; 

f\anction  Length_Of  (The_List  :  in  List)  return  Natural  is 
Count  :  Natural  :=  0; 

Index  :  List  :=  The_List; 

begin 

while  Index  /=  null  loop 
Count  :=  Count  +  1; 

Index  ;=  Index, Next ; 
end  loop; 
return  Count ; 
end  Length_Of; 

function  IsJNull  (The_List  :  in  List)  return  Boolean  is 
begin 

return  (The_List  =  null) ; 
end  Is^ull; 

function  Head_Of  (The_List  :  in  List)  return  Item  is 
begin 

return  The^List  .The_Item; 
exception 

when  Constraint_Error  => 
raise  List_Is^ull; 
end  Head^Of; 

function  Tail^Of  (The_List  :  in  List)  return  List  is 
begin 

return  The_List .Next; 
exception 

when  Constraint_Error  => 
raise  List_Is_JJull; 
end  Tail_Of; 

end  Lis  t_S  ingle_Unbounded_Managed ; 
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UST  SINGLE  UNBOUNDED  MANAGED 


PSDL 


lYPE  List_Single_UnboundecLMan.aged 
SPECIFICATION 
GENERIC 

Item  ;  PRIVATE_TyPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

FronL.The_List  :  List, 

To_'nie_List  :  List 
OUTPUT 

To_The_List  :  List 
EXCEPTIONS 

Overflow,  List_Is_Null 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_List  :  List 
OUTPUT 

The_List  :  List 
EXCEPTIONS 

Overflow,  List_IsJJull 

END 

OPERATOR  Construct 
SPECIFICATION 
INPUT 

The_Itein  :  Item, 

AndLThe_List  :  List 
OUTPUT 

And^The_Lis t  :  List 
EXCEPTIONS 

Overflow,  List_Is_Null 

END 

OPERATOR  Set^ead 
SPECIFICATION 
INPUT 

OfJThe^List  :  List, 

To_'nie_Item  :  Item 
OUTPUT 

Of_Ilie_List  ;  List 
EXCEPTIONS 

Overflow,  List_Is_Null 

END 

OPERATOR  Swap_Tail 
SPECIFICATION 
INPUT 

Of_The_List  :  List, 

AncLThe„List  :  List 
OUTPUT 

Of_The_List  :  List, 

And_The_List  ;  List 
EXCEPTIONS 

Overflow,  List_ls_Null 


END 

OPERATOR  Is^Equal 

SPECIFICATION 

INPUT 

Left  :  List, 

Right  :  List 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  List_Is_Null 

END 

OPERATOR  Length_Of 

SPECIFICATION 

INPUT 

The^List  ;  List 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  List_Is_Null 

END 

OPERATOR  IsJIull 

SPECIFICATION 

INPUT 

The_List  ;  List 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  List_Is_Null 

END 

OPERATOR  Head^Of 

SPECIFICATION 

INPUT 

The_List  :  List 
OUTPUT 

Result  ;  Item 
EXCEPTIONS 

Overflow,  List_Is_Null 

END 

OPERATOR  Tail_Of 

SPECIFICATION 

INPUT 

The_List  ;  List 
OUTPUT 

Result  :  List 
EXCEPTIONS 

Overflow,  List_IsJMull 

END 


END 

IMPLEMENTATION  ADA  List_Single_Unbounded_Managed 
END 
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LIST  SINGLE  UNBOUNDED  UNMANAGED 
ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

package  List_Single_Unbounded_Unmanaged  is 
type  List  is  private; 


procedure  Is_Null 
procedure  Head_Of 
procedure  Tail_Of 


(The^List 

Result 

(The^List 

Result 

(The_List 

Result 


in  List; 
out  Boolean) ; 
in  List; 
out  Item) ; 
in  List; 
out  List) ; 


Null_List  :  constant  List; 


end  o£  modification 


procedure  Copy  (Froit\_The_List 

To_The_List 

procedure  Clear  {The_List 

procedure  Construct  (The_Item 

And_The_List 

procedure  Set_Head  (of_The_List 
To_The_Item 


in  List ; 
in  out  List) ; 
in  out  List ) ; 
in  Item; 
in  out  List) ; 
in  out  List; 
in  Item) ; 


function  is^Ecjual  (Left 
Right 

function  Length_Of  (The_List 
function  Is^ull  (The_List 
function  Head_Of  (The^List 
fxinction  Tail_Of  (The^List 


:  in  List; 

:  in  List)  return  Boolean; 
:  in  List)  return  Natural; 
:  in  List)  return  Boolean; 
:  in  List)  return  Item; 

;  in  List)  return  List; 


—  modified  by  Vincent  Hong  and  Tuan  Nguyen 

—  date:  9  April  1995 

—  adding  procedures  to  replace  functions 


procedure  Is_Equal 
procedure  Length_Of 


{Left 

Right 

Result 

(The_List 

Result 


in  List; 
in  List; 
out  Boolean) ; 
in  List; 
out  Natural); 


Overflow  :  exception; 

List_Is_Null  :  exception; 

private 

type  Node; 

type  List  is  access  Node; 
Null^List  ;  constant  List  ;=  null; 
end  List_Single_Unbounded_Unmanaged; 
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LIST  SINGLE  UNBOUNDED  UNMANAGED 


ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  NToiober  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Con^puter 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Cotirt,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 


procedure  Is_Equal 


begin 

Result  :=  Is_Equal 
end  Is_Equal; 


(Left 

Right 

Result 


in  List; 
in  List; 
out  Booleeui)  is 


(Left, Right ) ; 


procedure  Length_Of  (The_List  :  in  List; 

Result  :  out  Natural)  is 

begin 

Result  :=  Length._Of  (The_List) ; 

end  Lengthu_Of; 


package  body  List_Single_Unbounded_Unnianaged  is 

type  Node  is 
record 

The_Item  :  I  tern; 

Next  :  List; 
end  record; 


procedure  Copy  { FronuThe_List  ;  in  List; 

To_The_List  :  in  out  List)  is 

Fronulndex  :  List  :=  FroirL_The_List; 

To_Index  ;  List  ; 
begin 

if  FroiiL.The_List  =  null  then 
To_The_List  :=  null; 

else 

To_The_List  :=  new  Node '  (The_I tern  =>  FronuIndex.The_Item, 

Next  =>  null ) ; 


To_lndex  ;=  To__TheJList ; 

Fronuindex  :==  FroitL.Index.Next; 
while  From^Index  /=  null  loop 

To_Index.Next  :=  new  Node  * (The_I tern 
From_lndex .  The_I  tern. 


Next 


null) ; 


To_Index  To_Index.Next ; 

Fronulndex  :=  FronuIndex.Next; 
end  loop; 
end  if; 
exception 

when  Storage^Error  => 
raise  Overflow; 
end  Copy; 


procedure  Clear  (The^List  ;  in  out  List)  is 
begin 

The^List  :=  null; 
end  Clear; 


procedure  ls_Null 
begin 

Result  : =  Is_Null 
end  Is^ull; 

procedure  Head_Of 

begin 

Result  :  =5  Head_0f 
end  Head_0f; 

procedure  Tail_Of 

begin 

Result  : =  Tail_Of 
end  Tail_0f; 

end  of  modification 


(The_List  :  in  List; 

Result  :  out  Boolean)  is 

{The_List) ; 


(The^List  :  in  List; 
Result  :  out  Item)  is 

(The_List) ; 


(The_List  :  in  List; 
Result  :  out  List)  is 

{The_List) ; 


function  Is_Equal  (Left  :  in  List; 

Right  :  in  List)  return  Boolean  is 
Left_Index  :  List  :=  Left; 

Right„Index  :  List  ;=  Right; 
begin 

while  Left_Index  /=  null  loop 

if  Left_Index,The_Item  /=  Right_Index.The_Item  then 
return  False; 
end  if; 

Left_lndex  Left_Index.Next ; 

Right_Index  :=  Right_Index,Next ; 
end  loop; 

return  (Right_Index  =  null) ; 
exception 

when  Constraint_Error  => 
return  False; 
end  Is_Equal; 


procedure  Construct  (The_Item  :  in  I tern; 

And_The_List  :  in  out  List)  is 

begin 

And_The_List  :=  new  Node  ‘  {The_I tern  =>  The_Item, 

Next  ->  And^The^List) ; 

exception 

when  Storage_Error  => 
raise  Overflow; 
end  Construct; 

procedure  Set^ead  (Of_The_List  :  in  out  List; 

To_The_Item  :  in  Item)  is 

begin 

Of_The_List .The_Item  :=  To„The_Item; 
exception 

when  Constraint_Error  => 
raise  List_Is JIull ; 
end  Set^ead; 

procedure  Swap_Tail  (Of_The_List  :  in  out  List; 

And_The_List  :  in  out  List)  is 
TemporaryJJode  :  List ; 
begin 

Teinporary_Node  :=  Of„The__List .Next; 

Of _The_Lis t .Next  : =  And_The_Lis t ; 

And_The_List  :=  Teit5Jorary_Node  ; 
exception 

when  Constraint_Error  => 
raise  List_Is_Null; 
end  Swap_Tail; 

modified  by  Vincent  Hong  and  Tuan  Nguyen 
date:  9  April  1995 

adding  procedures  to  replace  functions 


fianction  Length^Of  (The_List  :  in  List)  return  Natural  is 
Count  :  Natural  ;=  0; 

Index  :  List  :=  The^List; 
begin 

while  Index  null  loop 
Count  Count  +  1; 

Index  :=  Index, Next; 
end  loop; 
return  Count; 
end  Length_Of; 

function  IsJMull  (The_List  :  in  List)  return  Boolean  is 
begin 

return  (The_List  =  null) ; 
end  ls_Null; 

function  Head_Of  (Tfae_List  :  in  List)  return  Item  is 
begin 

re  turn  The^Lis  t . The_I t em ; 
exception 

when  Cons train t_Err or  => 
raise  List„Is_Null; 
end  Head_0f; 

function  Tail^Of  (The_List  :  in  List)  return  List  is 
begin 

return  The_List.Next; 
exception 

when  Constraint_Error  => 
raise  List_Is^ull; 
end  Tail_Of; 

end  List_Single_Unbounded_Unmanaged; 
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LIST  SINGLE  UNBOUNDED  UNMANAGED 


PSDL 


TYPE  List_Singlejanboundec3UUninanaged 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

Froit\_The_List  :  List, 
To_TheJList  ;  List 
OUTPUT 

To_The_List  :  List 
EXCEPTIONS 

Overflow,  List_Is_Null 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The^List  :  List 
OUTPUT 

The_List  :  List 
EXCEPTIONS 

Overflow,  List_IsJNull 

END 

OPERATOR  Construct 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

And_The_List  :  List 
OUTPUT 

And^The_List  :  List 
EXCEPTIONS 

Overflow,  List_Is_Null 

END 


Right  :  List 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  List_Is_Null 

END 

OPERATOR  Length^Of 

SPECIFICATION 

INPUT 

The_List  :  List 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  List_Is_Null 

END 

OPERATOR  Is_Null 

SPECIFICATION 

INPUT 

The_List  :  List 
OUTPUT 

Result  :  Boolecin 
EXCEPTIONS 

Overflow,  List_Is_Null 

END 


OPERATOR  Head^Of 
SPECIFICATION 
INPUT 

The_List  :  List 
OUTPUT 

Result  :  Item 
EXCEPTIONS 

Overflow,  List_IsJN[ull 

END 


OPERATOR  Set^ead 
SPECIFICATION 
INPUT 

Of_The_List  :  List, 
To_The_Item  ;  Item 
OUTPUT 

Of_The_List  :  List 
EXCEPTIONS 

Overflow,  List_Is_Null 

END 


OPERATOR  Tail_Of 
SPECIFICATION 
INPUT 

The_List  :  List 
OUTPUT 

Result  :  List 
EXCEPTIONS 

Overflow,  List^IsJMull 

END 


OPERATOR  Is_Equal 
SPECIFICATION 
INPUT 

Left  :  List, 


END 

IMPLEMENTATION  ADA  List_Single_Unbounded„Unmanaged 
END 
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MAP  SIMPLE  NONCACHED  SEQUENTIAL  BOUNDED  MANAGED  ITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Domain  is  private; 
type  Ranges  is  private; 

with  fLinction  Hash_Of  (The^Domain  ;  in  Domain)  return  Positive; 

—  modified  by  Tuan  Nguyen  and  Vincent  Hong 

—  date:  8  April  1995 

adding  procedures  to  replace  fionctions 

with  procedure  Hash_Of  (The__Domain  :  in  Doxnain; 

Result  :  out  Positive); 

—  end  of  medication 

package  Map„Siitple_Noncached_Sequential_BoundedLJlanaged_Iterator  is 

type  Map(The„Size  :  Positive)  is  limited  private; 

procedure  Copy  (Froin^The_Map  :  in  Map; 

To_TheJMap  :  in  out  Map) ; 

procedure  Clear  (The^Map  :  in  out  Map) ; 

procedure  Bind  {The__Domain  :  in  Domain; 

And_The_Range  :  in  Ranges ; 

In_The_Map  :  in  out  Map)  ; 

procedure  Unbind  (The_Doiiiain  :  in  Domain; 

In_The^ap  ;  in  out  Map); 

—  modified  by  Tuan  Nguyen  and  Vincent  Hong 

—  date:  8  April  1995 

adding  procedures  to  replace  functions 

procedure  Is_Equal  (Left  :  in  Map; 

Right  :  in  Map; 

Result  :  out  BoolCcin)  ; 
procedure  Extent_Of  (The_Map  :  in  Map; 

Result  :  out  Natural); 

procedure  Is_Enpty  (The_Map  :  in  Map; 

Result  :  out  Boolean) ; 
procedure  Is^Bound  (The_Domain  :  in  Domain; 

IrL_The_Map  :  in  Map; 

Result  :  out  Boolean) ; 


procedure  Range_Of  (The_Domain  :  in  Domain; 

In_TheJMap  :  in  Map; 

Result  :  out  Ranges); 

—  end  of  modi cat ion 

fxmetion  Is_Egual  (Left  :  in  Map; 

Right  :  in  Map)  return  Boolean; 

fxinction  Extent_Of  (The^Map  :  in  Map)  return  Natural; 

function  Is_Enpty  (The_Jlap  :  in  Map)  return  Boolean; 

function  Is^Boxind  (The^Domain  :  in  Domain; 

In_The_JMap  :  in  Map)  return  Boolean; 
function  Range_Of  {The_Domain  :  in  Domain; 

In_The_Map  :  in  Map)  return  Ranges; 

generic 

with  procedure  Process  (The_Domain  ;  in  Domain; 

The_Range  :  in  Ranges ; 

Continue  :  out  Boolean) ; 

procedure  Iterate  (Over_The_Map  :  in  Map) ; 

Overflow  :  exception; 

Doinain_ls_Mot_Bo\md  :  exception; 

Multiple_Binding  :  exception; 

private 

type  State  is  (Ertpty,  Deleted,  Bound)  ; 
type  Node  is 
record 

The_State  ;  State  :=  Enpty; 

The_Domain  :  Domain; 

The_Range  :  Ranges; 
end  record; 

type  Items  is  array  (Positive  range  <>)  of  Node; 
type  Map(The_Si2e  :  Positive)  is 
record 

The_Items  :  Items (1  ..  The_Size) ; 

The_Count  :  Natural  :=  0; 
end  record; 

end  Map_Siinple_NoncachecLSequential_BoundedJManaged_Iterator 
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MAP  SIMPLE  NONCACHED  SEQUENTIAL  BOUNDED  MANAGED  ITERATOR 

ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Nvunber  0100219 


end  if; 
exception 

when  Constraint_Error  => 
raise  Overflow; 
end  Bind; 


-Restricted  Rights  Legend" 

Use,  duplication,  or  disclosure  is  s^abject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3)  {ii) 

—  of  the  rights  in  Technical  Data  and  Coit5)uter 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body  Map_Siinple_Noncached_Sequential_Bounded_Managed_Iterator 
is 


procedure  Find  (The_Domain  :  in  Domain; 

In^TheJMap  :  in  Map; 

The^Bucket  :  out  Natural)  is 
Initial_Probe  :  Natural  := 

Hash_0f (The_Domain)  mod 

In_The_Map . The_Size ; 

Terrporary_Index  ;  Positive; 

Temporary_Bucket  :  Natural; 
begin 

Ten:^orary_3ucket  :=  0; 

for  Index  in  IrL_TheJMap.The_I terns 'Range  loop 
Temporary_Index  :  = 

((Index  +  Initial_Probe  -  2)  mod  In_The_^ap.The_Size)  + 


1; 

case  ln_The,^p. The_I terns (Temporary^Index)  .The_State  is 
when  Empty  => 

if  Temper ary_Bucket  =  0  then 

Temper ary_Bucket  :=  Teaporary_Index ; 
end  if; 

The^Bucket  Tenporary^Bucket; 
return; 

when  Deleted  => 

if  Teitporary_Bucket  *=  0  then 

Teirporary_Bucket  :=  Teiiporary_Index  ; 
end  if; 

when  Bound  => 
if 

In jrhe_Map .  The_I  terns  ( TeiTporary_Index )  .  The_Doma  in  = 

'rhe_Domain  then 
The_Bucket  :=  Tenporary_Index; 
retum; 
end  if; 


end  case; 
end  loop; 

The^Bucket  ;=  Tenporary_Bucket ; 
end  Find; 


procedure  Copy  ( Fr om_The_Map  :  in  Map; 

To_The_Jlap  ;  in  out  Map)  is 
The_Bucket  :  Natural ; 
begin 

if  FroitL.The_Map.The_Count  >  To_The_Map.The_Size  then 
raise  Overflow; 

else 

for  Index  in  To_The^ap-The_I terns 'Range  loop 

To_The _Map .  The_I  terns  ( Index )  .  The_S  t at  e  :  =  Enp  ty  ; 
end  loop; 

To_The_Map . The_Count  : =  0 ; 

for  Index  in  From_The_Jtap .The_Items 'Range  loop 

if  From_TheJIap.The_Items (Index)  .The_State  =  Bound 
i 

Find  ( Front_The_Map .  The_I terns  ( Index )  .  The_Domain , 
To_The_Map,  The_Bucket) ; 

To_The_Map . The_I terns (The_Bucket )  : = 
From_The_Map . The_Items ( Index) ; 
end  if; 
end  loop; 

To_The_Map .  The_Count  :  =  From_The_Map .  The_Coiint ; 
end  if; 
end  Copy; 

procedure  Clear  (The_Map  :  in  out  Map)  is 
begin 

for  Index  in  The_Map.The_I terns 'Range  loop 

The_Map. The_I terns  (Index)  .The_State  :=  Enpty; 
end  loop; 

TheJMap.The_Count  0; 
end  Clear; 

procedure  Bind  (The^Domain  :  in  Domain; 

And_The_Range  :  in  Ranges; 

In_The_Map  :  in  out  Map)  is 

The_Bucket  :  Natural ; 
begin 

Find  ( The_Doina  in ,  In_The_Map ,  The_Bucke  t )  ; 

if  In_The_Map.The_Items(The_Bucket)  .The_State  =  Bound  then 
raise  Multiple_Binding; 
else 

In^TheJMap .  The_Iteins  (The^Bucket )  :  = 

Node' (Bound,  The_Domain,  And_The_Range)  ; 
In_The_Map.The_Cotxnt  In_The_Map . The^Count  +  1; 


procedure  Unbind  (The_Dooiain  :  in  Domain; 

In_lhe_Map  :  in  out  Map)  is 
The^Bucket  :  Natural; 
begin 

Find(The_Doinain,  In_The_Map,  The_Bucket)  ; 

if  In_The_Map.The_Items(The_Bucket)  .The_State  =  Bound  then 
In_The_Map.The_Items{The_Bucket)  .The_State  Deleted; 
In_The_Map .  The_Count  :=  In_The_Map .  The^Coiint  -  1; 

else 

raise  Domain_Is_Not_Bound; 
end  if; 
exception 

when  Constraint_Error  => 

raise  Domain_I s_No t_Bound ; 
end  Unbind; 

—  modified  by  Tuan  Nguyen  and  Vincent  Hong 

—  date:  8  April  1995 

—  adding  procedures  to  replace  functions 

procedure  Is_Equal  (Left  :  in  Map; 

Right  :  in  Map; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is_Equal (Left, Right ) ; 
end  Is_Equal; 

procedure  Extent_0f  {The_Map  ;  in  Map; 

Result  :  out  Natural)  is 

begin 

Result  :=  Extent_Of (The_Map) ; 
end  Extent_0f; 

procedure  Is_Eirpty  (The_Map  :  in  Map; 

Result  :  out  Boolean)  is 

begin 

Result  Is_Enpty(The_Map) ; 
end  Is_Ertpty; 

procedure  Is_Bound  (The_Domain  :  in  Domain; 

In_TheJlap  ;  in  Map; 

Result  :  out  Boolean)  is 

begin 

Resul  t  :  =  Is_Bo\ind  ( The_Domain ,  In_The  JMap )  ; 
end  Is_BOTmd; 

procedure  Range^Of  (The_Domain  :  in  Domain; 

In_The_Map  :  in  Map; 

Result  :  out  Ranges)  is 

begin 

Result  :=  Range_Of  (The_Domain,  In_The^Map)  ; 
end  Range^Of; 

—  end  of  modification 


fimction  Is_Equal  (Left  :  in  Map; 

Right  :  in  Map)  return  Boolean  is 
Temporary_Index  :  Natural ; 
begin 

if  Left.The_Coimt  /=  Right . The_Count  then 
return  False; 

else 

for  Index  in  1  . .  Left .The_Size  loop 

if  Left  ,The_I terns  (Index)  .The_State  -  Bovind  then 
Temporary_Index  rss  0; 

for  Inner_Index  in  1  . .  Right ,The_Size  loop 

i  f  ( Right .  The_I  t  ems  ( Index )  .  The_S  t a  t e  =  Bovind ) 

and  then 

(Left.  The_I  terns  ( Index )  .  The_Domain  = 

Right  .The_I terns  ( Inner_Index)  .The_Domain) 

then 

Teir5>orary_Index  :=  lnner_Index; 
exit; 
end  if; 
end  loop; 

if  Left.The_I terns  (Index)  .The^Range  /= 

Right  .The„I  terns  ( Temper ary^Index)  .The_Range  then 
retumri  False; 
end  if; 
end  if; 
end  loop; 
return  True; 
end  if; 
exception 

when  Constraint_Error  => 
return  False; 
end  Is_Equal; 

fxanction  Extent_Of  (Thejlap  :  in  Map)  return  Natural  is 
begin 

return  The_Map .  The_Count  ; 
end  Extent_Of; 
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function  Is_E[r5>ty  {The_Ilap  :  in  Map)  return  Boolean  is 
begin 

return  {The_jMap.The_Count  =  0); 
end  Is_Eit5>ty; 

function  Is_Bound  (The_Domain  :  in  Domain; 

InJThejaap  :  in  Map)  return  Boolean  is 
The_Bucket  :  Natural; 
begin 

Find ( The JDomain,  In_The_Map,  The_Bucket); 

return  ( ln_The_Map.The_I terns (The^Bucket)  .The_State  =  Bound); 
exception 

when  Constraint_Error  => 
return  False; 
end  IsJBo\md; 

function  Range_Of  (The_Domain  :  in  Domain; 

In_The_Map  :  in  Map)  return  Ranges  is 
The_Bucket  :  Natural; 
begin 

Find(The_Domain,  In_The_Map,  The_Bucket) ; 

if  In_The_Map. The_I terns (The_Bucket) .The^State  =  Bound  then 


return  In_The Jlap .  The_Iteins  (The_Bucket )  .  The^Range  ; 

else 

raise  Doma in_Is_No t_Bound ; 
end  if; 
exception 

when  Constraint_Error  => 

raise  Doinain«.Is_Not_Bound; 
end  Range_Of; 

procedure  Iterate  {Over_TheJlap  :  in  Map)  is 
Continue  :  Boolean; 
begin 

for  Index  in  Over_TheJIap.The_I terns 'Range  loop 

if  Over_The_Map -The_I terns  ( Index )  .The_State  =  Bound  then 
Process (Over^TheJIap . The_I terns ( Index) . The_Domain, 
Over_The_Map . The_I terns ( Index) . The_Range , 
Continue) ; 

exit  when  not  Continue; 
end  if; 
end  loop; 
end  Iterate; 

end  Map_Siiiple_Noncached_Seguential_Bounded_Managed_Iterator ; 
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MAP  SIMPLE  NONCACHED  SEQUENTIAL  BOUNDED  MANAGED  ITERATOR 

PSDL 


TYPE  Map_Siii:5)leJNoncached_Sec3uential_Bo\mdedJlanaged_Iterator 
SPECIFICATION 
GENERIC 

Domain  :  PRIVATE_TyPE, 

Ranges  ;  PRIVATE_TYPE, 

Hash_Of  :  FUNCTION [The_Domain  :  Domain,  RETURN  ;  Positive] , 
HasluOf  :  PROCEDURE [The_Domain  :  in[t  :  Domain],  Result  :  out[t  : 
Positive] ] 

OPERATOR  Copy 
SPECIFICATION 
INPUT 

FronuTheJMap  :  Map, 

To_The_Map  :  Map 
OUTPUT 

To^TheJlap  :  Map 
EXCEPTIONS 

Overflow,  Domain„Is_Not_Bound,  Multiple_Binding 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The^Map  :  Map 
OUTPUT 

The_Map  ;  Map 
EXCEPTIONS 

Overflow,  Domain_Is_Not_Bound,  Multiple_Binding 

END 

OPERATOR  Bind 
SPECIFICATION 
INPUT 

The_Domain  ;  Domain, 

AnoUrhe_Range  :  Ranges, 

In_TheJMap  :  Map 
OUTPUT 

In„The_Map  :  Map 
EXCEPTIONS 

Overflow,  Doinain_Is_Not_Bound,  Multiple_Binding 

END 

OPERATOR  Unbind 
SPECIFICATION 
INPUT 

The^Domain  ;  Domain, 

In-.The  Jlap  :  Map 
OUTPUT 

In_The_Jlap  :  Map 
EXCEPTIONS 

Overflow,  Domain_IsJJot_Bo\jnd,  Multiple_Binding 

END 

OPERATOR  Is_Equal 
SPECIFICATION 
INPUT 

Left  :  Map, 

Right  :  Map 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 


Overflow,  Domain_Is_Not_Bound,  Multiple_Binding 

END 

OPERATOR  Extent^Of 

SPECIFICATION 

INPUT 

The^ap  :  Map 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Domain_Is_Not_Bound,  Multiple_Binding 

END 

OPERATOR  Is_Einpty 

SPECIFICATION 

INPUT 

Thejrtap  :  Map 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Doniain_Is_Not_Botind,  Multiple_Binding 

END 

OPERATOR  Is^Bound 

SPECIFICATION 

INPUT 

The_Doinain  :  Domain, 

In_The_Map  :  Map 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Domain_Is_Not_Bound,  Multiple_Binding 

END 

OPERATOR  Range_Of 

SPECIFICATION 

INPUT 

The^Domain  :  Domain, 

In_The,JIap  :  Map 
OUTPUT 

Result  :  Ranges 
EXCEPTIONS 

Overflow,  Domain_Is_Not_Bound,  Multiple_Binding 

END 

OPERATOR  Iterate 

SPECIFICATION 

GENERIC 

Process  ;  PROCEDURE I The_Doma in  :  in[t  :  Domain],  The^Range 
in[t  :  Ranges],  Continue  :  out[t  :  Boolecin]  ] 

INPUT 

Over_The_Jiap  :  Map 
EXCEPTIONS 

Overflow,  Domain_Is_Not_Bound,  Multiple_Binding 

END 

END 

IMPLEMENTATION  ADA 

Map_Sinple_Noncached_Se<3uential„Bounded_Managed_Iterator 

END 
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MAP  SIMPLE  NONCACHED  SEQUENTIAL  BOUNDED  MANAGED  NONITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Dotaain  is  private; 
type  Ranges  is  private; 

Number_Of_Buckets  :  in  Positive; 

with  function  Hash_Of  (The„Domain  :  in  Domain)  return  Positive; 

—  modified  toy  Tuan  Nguyen  and  Vincent  Hong 

—  date:  8  April  1995 

adding  procedures  to  replace  functions 

with  procedure  Hash_Of  (The_Domain  :  in  Domain ; 

Result  :  out  Positive) ; 

—  end  of  medication 

package  Map_SirpleJ3oncached^Sequential_Unbounded_Managed_JJoniterator 
is 

type  Map  is  limited  private; 

procedure  Copy  (From^TheJUap  :  in  Map; 

To^TheJMap  :  in  out  Map) ; 

procedure  Clear  (The_Map  :  in  out  Map) ; 

procedure  Bind  (The^Domain  :  in  Domain; 

And_The_Range  :  in  Ranges ; 

In_The_Map  :  in  out  Map )  ; 

procedure  Unbind  (The^Domain  :  in  Domain; 

In_TheJIap  :  in  out  Map) ; 

—  modified  by  Tuan  Nguyen  and  Vincent  Hong 

—  date:  8  April  1995 

—  adding  procedures  to  replace  functions 
procedure  Is_Equal  (Left  :  in  Map; 


Right  :  in  Map; 

Result  :  out  Boolean) ; 
procedure  ExtentjOf  (The_Map  :  in  Map; 

Result  :  out  Natural) ; 

procedure  Is_Enpty  (TheJMap  :  in  Map; 

Result  :  out  Boolean) 
procedure  Is_Bound  {The_Doinain  ;  in  Domain; 

In_The_Map  :  in  Map; 

Result  :  out  Boolean) ; 

procedure  Range__Of  {The_Domain  :  in  Domain; 

Ii;_TheJIap  :  in  Map; 

Result  :  out  Ranges) ; 

—  end  of  modication 

function  Is_Equal  (Left  :  in  Map; 

Right  :  in  Map)  return  Boolean; 

function  Extent_Of  (The_Map  :  in  Map)  return  Natural; 

function  Is_Enpty  (TheJMap  :  in  Map)  return  Boolean; 

function  Is_Boimd  (The^Domain  ;  in  Domain; 

In_TheJlap  ;  in  Map)  return  Boolean; 
function  Range_Of  (The_Domain  :  in  Domain; 

In_The_Map  :  in  Map)  return  Ranges; 

Overflow  :  exception; 

Domain_IsJMot_Bound  :  exception; 

Multiple_Binding  :  exception; 

private 

type  Node; 

type  Structure  is  access  Node; 

type  Map  is  array  (Positive  range  1  . .  Nuinber_Of_Buckets)  of 
Structure; 

end  Map_Simple_Noncached_Seguential_Unbounde<3LManagecUJoniterator 


MAP  SIMPLE  NONCACHED  SEQUENTIAL  BOUNDED  MANAGED  NONITERATOR 

ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 
--All  Rights  Reserved 

—  Serial  Number  0100219 

•Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  sijbject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Con5>uter 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer; 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

with  Storage_Manager_Sequential ; 

package  body  ,  •  * 

Map__Sinple_Noncached_Sequential_Unbounded_Jlanaged_Noniterator  is 


type  Node  is 
record 

The_Domain  :  Domain ; 

The^Range  :  Ranges ; 

Next  :  Structure; 

end  record; 

procedure  Free  (The^ode  :  in  out  Node)  is 
begin 

null; 
end  Free; 


procedure  Set_Next  (The_Node  :  in  out  Node; 

ToJMext  :  in  Structure)  is 

begin 

The_Node.Next  :=  To_Next; 
end  Set_Next; 

function  Next_Of  (The^ode  :  in  Node)  return  Structure  is 
begin 

return  The_Node.Next ; 
end  Next^Of; 


package  Node_Manager  is  new  Storage_Kanager_Seguential 

(Item  =>  Node, 

Pointer  =>  Structure, 
Free  =>  Free, 

Set_Pointer  =>  SetJNext, 
Pointer _Of  =>  Next_Of ) ; 


procedure  Find  (The_Doinain  :  in  Domain; 

In_TheJMap  :  in  Map; 

The_Bucket  :  out  Positive; 

Previous_Node  :  in  out  Structure; 

Current_Node  :  in  out  Structure)  is 

Teii5)orary_Bucket  ;  Positive  :  = 

(Hash_Of  (The^Domain)  mod 

Nuinber_Of_Buckets )  +  1  ; 
begin 

The_Bucket  :=  Teirporary_Bucket ; 

Current_Node  :=  In_The_Map(Ten?)orary_Bucket )  ; 
while  Current_Node  /=  null  loop 

if  Current_Node . The^Domain  =  The_Domain  then 
return; 

else 

Previous_Node  : =  Current  J^ode ; 
Current_Node  : =  Current^Node .  Next ; 
end  if; 
end  loop; 
end  Find; 


procedure  Clear  (TheJIap  :  in  out  Map)  is 
begin 

for  Index  in  The_Map *  Range  loop 

Node JManager . Free ( The_Map ( Index ) ) ; 
end  loop; 
end  Clear ; 


procedure  Bind  (The^Domain  : 

And_The_Range  : 
In_The_Map  : 

The_Bucket  ;  Positive; 

PreviousJMode  :  Structure; 
Current JWode  ;  Structure; 
TenporaryJNode  ;  Structure; 
begin 

F ind ( The_Domain ,  In_The_Map , 
Current_Node)  ; 

if  Current_Node  /=  null  then 
raise  Multiple_Binding; 


in  Domain; 
in  Ranges ; 
in  out  Map)  is 


The^Bucket,  Previous_JIode, 


else 

Teirporary_Node  :=  Node_Manager  .New_Item; 

Temper aryJNode .  The_Dotnain  :=  The_Domain; 
Ten5>orary_Node .  The_Range  :  =  And_The_Range ; 
Ternporary JMode .  Next  :  -  In_The_Map  ( The^Bucket ) ; 
IruThe J!ap  { The^Bucke  t )  :  =  Tenporary^ode  ; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Bind; 


procedure  Unbind  (The^Domain  ;  in  Domain; 

In_The_Map  ;  in  out  Map)  is 
The^Bucket  ;  Positive; 

Previous Jlode  :  Structure; 

Current_Node  :  Structure; 
begin 

Find(The_Domain,  In_TheJIap,  The_Bucket,  Previous^Node, 
Current_Node) ; 

if  Previous_Node  *  null  then 

In_The_Map  (The_Bucket)  :=  Current_Node.Next; 

else 

Previous_Node.Next  :=  Current^Node.Next; 
end  if; 

CurrentJNode.Next  :=  null; 

Node JManager . Free ( Current^Node ) ; 
exception 

when  Cons train t_Err or  => 

raise  Doinain_Is_Not_,Bound; 
end  Unbind; 


—  modified  by  Tuan  Nguyen  and  Vincent  Hong 

—  date:  8  April  1995 

adding  procedures  to  replace  functions 

procedure  Is_Ec[ual  (Left  :  in  Map; 

Right  :  in  Map; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is_Equal (Left, Right) ; 
end  Is_Equal; 

procedure  Extent_Of  (The_Map  :  in  Map; 

Result  :  out  Natural)  is 

begin 

Result  :=  Extent_Of (The_Map) ; 
end  Extent_Of; 


procedure  Copy  ( Fr om_The_Map  :  in  Map; 

To_The_Map  :  in  out  Map)  is 
Fronulndex  :  Structure; 

To_Index  :  Structure; 
begin 

for  Index  in  To_The_Map ' Range  loop 

Node_^lanager  *  Free  {To_The^ap  ( Index) )  ; 
end  loop; 

for  Index  in  FrorcL_TheJlap  ’  Range  loop 
From__Index  :=  FroiiL_The_Map (Index)  ; 
if  From_The_Map( Index)  /=  null  then 

To_The_Map(  Index)  Node^Meinager  .New_Item; 

To_The Jlap  ( Index )  .  The_Domain  :  =  From_Index .  The_Domain ; 
To_The JX(ap  ( Index )  .  The_Range  :  =  Fr om_Index .  The_Range  ; 
To_Index  :  =  To_The_Map  ( Index )  ; 

From_Index  :=  FronuIndex.Next ; 
while  From_Index  /=  null  loop 

To_Index,Next  :=  Node_Manager.New_Item; 
To_Index.Next.The_Domain  :=  From_Index.The_Domain; 
To_Index.Next.The_Range  :=  Fr om_Index , The_Range ; 
To_lndex  :  =  To_Index .  Next ; 

From_Index  ;=  From_Index.Next ; 
end  loop; 
end  if; 
end  loop; 
exception 

when  Storage_Error  »> 
raise  Overflow; 
end  Copy; 


procedure  Is_En^ty  {The_Map  :  in  Map; 

Result  :  out  Boolean)  is 

begin 

Result  ;=  Is_Empty{TheJlap) ; 
end  Is_Enpty; 

procedure  Is_Bovind  (The^Domain  :  in  Domain; 

In_The_Map  :  in  Map; 

Result  ;  out  Boolean)  is 

begin 

Resul  t  :  =  Is_Boimd  ( The^Domain ,  In_The_Map )  ; 
end  Is_Bound; 

procedure  Range_Of  (The_Domain  :  in  Domain; 

In_The_Map  :  in  Map; 

Result  :  out  Ranges)  is 

begin 

Result  :=  Range_Of (The_Domain, In_The_Map) ; 
end  Range_Of; 

end  of  modification 

function  Is_Egual  (Left  :  in  Map; 

Right  :  in  Map)  return  Boolean  xs 
Left_Index  :  Structure; 

Right^Index  :  Structure; 

Lef t_Count  :  Natural ; 

Right_Count  :  Natural; 
begin 
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for  Index  in  Left 'Range  loop 

if  (Left (Index)  =  null)  xor  (Right (Index)  =  null)  then 
return  False; 

else 

Left^Index  :=  Left (Index); 

Left_Count  ;=  0; 

while  Left_Index  t-  null  loop 

Rigiit-Index  :=  Right  (Index)  ; 
while  Right_Index  /=  null  loop 
if  ( Le f t_Index . The_Domain  = 

Ri  ght_Index .  The_Doina  in )  then 
exit; 

else 

Right_Index  :=  Right_Index,Next; 
end  if; 
end  loop; 

if  Left_Index.The_Range  /=  Right^Index . The^Range 

then 

return  False; 

else 

Left_Index  :=  Left^Index.Next; 

Left_Count  :=  Left_Count  +  1; 
end  if; 
end  loop; 

Right_Index  :ss  Right  (Index)  ; 

Right_Coiint  :=  0; 

while  Right_Index  /=  null  loop 

Right_Index  :=  Right_Index . Next ; 

Right_Count  :=  Right_Count  +  1; 
end  loop; 

if  Left_Co\int  I-  Right__Count  then 
return  False; 
end  if; 
end  if; 
end  loop; 
return  True; 
exception 

when  Constraint_Error  => 
return  False; 
end  Is_Equal ; 

function  Extent_0f  (The,Jlap  :  in  Map)  return  Natural  is 
Count  :  Natural  :=  0; 


Tempo rary^Node  :  Structure; 
begin 

for  Index  in  The Jlap '  Range  loop 

Tenpor ary_Node  :  =  The__Map  ( Index )  ; 
while  Temporary^ode  /=  null  loop 
Count  ;=  Count  +  1; 

TemporaryJNode  ;  =  Temporary^Node .  Next  ; 
end  loop; 
end  loop; 
return  Count; 
end  Extent^Of; 

fxinction  Is_Eitpty  (The^Nap  :  in  Map)  return  Boolean  is 
begin 

return  (TheJMap  =  Map' (others  =>  null)); 
end  Is_Enpty; 

function  Is_Botind  (The_Doinain  :  in  Domain; 

In_The_Jlap  :  in  Map)  return  Boolean  is 
The_Bucket  :  Positive; 

Previous_Node  :  Structure; 

Current_Node  :  Structure; 
begin 

Find{The_Domain,  In_The_Mapy  'Ihe_Bucket,  Previous_Node, 
CurrentJJode) ; 

return  (Current^ode  /=  null) ; 
end  Is_Bound; 

function  Range_Of  (The_Domain  :  in  Domain; 

In_The_Map  :  in  Map)  return  Ranges  is 
The^Bucket  ;  Positive; 

Previous_Node  ;  Structure; 

Current_^ode  :  Structure; 
begin 

Find(The_Domain,  In_The_Map,  The_Bucket,  PreviousJNode, 
CurrentJJode) ; 

return  CurrentJJode . The_Range ; 
exception 

when  Constraint_Error  => 

raise  Domain_Is_Not_BoTmd; 
end  Range_0f; 

end  Map_Siinple_Noncached_Sequential_UnboundedJlanaged_Noniterator 
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MAP  SIMPLE  NONCACHED  SEQUENTIAL  BOUNDED  MANAGED  NONITERATOR 

PSDL 


TYPE  Map_Sinple^oncached_Se<3uential_Unbounded_ManagedJIoni tera tor 
SPECIFICATION 
GENERIC 

Domain  :  PRIVATE_TYPE, 

Ranges  :  PRIVATE_TYPE, 

Hash_Of  :  FUNCTION [The^Domain  :  Domain,  RETURN  ;  Positive] , 
Hash_Of  :  PROCEDURE [The^Domain  :  in[t  :  Domain],  Result  :  out[t  : 
Positive] ] 

OPERATOR  Copy 
SPECIFICATION 
INPUT 

FronuTheJMap  :  Map, 

To_The_Map  :  Map 
OUTPUT 

To„The_JIap  :  Map 
EXCEPTIONS 

Overflow,  Domain_Is_Not_Bound,  Multiple_Binding 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

Thejlap  ;  Map 
OUTPUT 

Thejlap  :  Map 
EXCEPTIONS 

Overflow,  Domain_IsJMot_Bound,  Multiple_Binding 

END 

OPERATOR  Bind 
SPECIFICATION 
INPUT 

The_Doinain  :  Domain, 

And_The_Range  ;  Ranges, 

In_The_^ap  :  Map 
OUTPUT 

In_TheJMap  :  Map 
EXCEPTIONS 

Overflow,  Domain_IsJJot_Bound,  Multiple_Binding 

END 

OPERATOR  Unbind 
SPECIFICATION 
INPUT 

The_Domain  ;  Domain, 

In_The_^p  :  Map 
OUTPUT 

In_The_Map  :  Map 
EXCEPTIONS 

Overflow,  Domain_Is_JIot_Bound,  Multiple_Binding 

END 

OPERATOR  Is^Equal 
SPECIFICATION 
INPUT 


Left  :  Map, 

Right  :  Map 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Domain_Is_Not_Bo\md,  Multiple_Binding 

END 

OPERATOR  Extent_Of 

SPECIFICATION 

INPUT 

The_Map  ;  Map 
OUTPUT 

Result  ;  Natural 
EXCEPTIONS 

Overflow,  Domain_Is_Not_Bound,  Multiple_Binding 

END 

OPERATOR  Is_Empty 

SPECIFICATION 

INPUT 

The_Map  :  Map 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Domainal s_Not_Bound,  Multiple_Binding 

END 

OPERATOR  Is^Bound 

SPECIFICATION 

INPUT 

The_Doinain  :  Domain, 

In_TheJMap  :  Map 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Domain_Is_Not_Bo%ind,  Multiple_Binding 

END 

OPERATOR  Range_Of 

SPECIFICATION 

INPUT 

The_Domain  ;  Domain, 

In^The_J4ap  :  Map 
OUTPUT 

Result  :  Reinges 
EXCEPTIONS 

Overflow,  Domain_Is_Not_Bound,  Multiple^Binding 

END 

END 

IMPLEMENTATION  ADA 

14ap_Simple_Jsroncached_Sequential_Unbounded_ManagedJJoni  tera  tor 

END 
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MAP  SIMPLE  NONCACHED  SEQUENTIAL  UNBOUNDED  MANAGED  ITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Domain  is  private; 
type  Ranges  is  private; 

Nuinber_0£_Buckets  :  in  Positive; 

with  fimction  Hash_Of  {The_Domain  :  in  Domain)  return  Positive; 

—  modified  by  Tuan  Nguyen  and  Vincent  Hong 

—  date;  8  April  1995 

adding  procedures  to  replace  functions 

with  procedure  Hash_0£  (The_Doinain  :  in  Domain; 

Result  :  out  Positive) ; 

—  end  of  modication 

package  Map_Sin?>le_NoncachecLSequential_UnboundedJIanaged_Iterator  is 

type  Map  is  limited  private; 

procedure  Copy  (From_The_Nap 
To_The_JMap 

procedure  Clear  (The_Nap 
procedure  Bind  (The_Domain 

Andjrhe_Range 
In_The^ap 
procedure  Unbind  (The_Doinain 
In^TheJlap 

—  modified  by  Tuan  Nguyen  and  Vincent  Hong 

—  date:  8  April  1995 

—  adding  procedures  to  replace  f\inctions 

procedure  Is_Equal  (Left  ;  in  Map; 

Right  :  in  Map; 

Result  :  out  Boolean) ; 
procedure  Extent_Of  (Thejfap  ;  in  Map; 

Result  :  out  Natural ) ; 


:  in  Map; 

:  in  out  Map )  ; 

:  in  out  Map)  ; 

:  in  Domain; 
:  in  Ranges ; 
;  in  out  Map ) ; 

:  in  Domain; 
:  in  out  Map)  ; 


procedure  Is_Errpty  (The_Map  :  in  Map; 

Result  :  out  Boolean) ; 
procedure  Is_Bound  (The_Domain  :  in  Domain; 

In_The_Map  :  in  Map; 

Result  :  out  Boolean) ; 

procedure  Range^Of  (The_Domain  ;  in  Domain; 

In_The_Map  :  in  Map; 

Result  :  out  Ranges) ; 

—  end  of  modication 

function  Is^Equal  (Left  :  in  Map; 

Right  :  in  Map)  return  Boolean; 

function  Extent_Of  {The_Map  :  in  Map)  return  Natural; 

function  Is_Enpty  {The_Map  :  in  Map)  return  Boolean; 

fionction  Is^ound  {The_Domain  :  in  Domain; 

In_The_Map  :  in  Map)  return  Boolean; 
function  Range_Of  (The^Domain  ;  in  Domain; 

In_The_Map  :  in  Map)  return  Ranges; 

generic 

with  procedure  Process  (The_Domain  ;  in  Domain; 

The_Range  ;  in  Ranges ; 

Continue  ;  out  Boolean) ; 

procedure  Iterate  ( Over_The_Map  :  in  Map) ; 

Overflow  :  exception; 

Domain_Is_Not_Bound  ;  exception; 

Multiple_Binding  :  exception; 

private 

type  Node; 

type  Structure  is  access  Node; 

type  Map  is  array  (Positive  range  1  .  .  Nuinber_Of_Buckets )  of 
Structure; 

end  Map_S  impl  e  JJonc  ached_Sequent  i  al_Unbounded_Managed_I  t  era  tor ; 
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MAP  SIMPLE  NONCACHED  SEQUENTIAL  UNBOUNDED  MANAGED  ITERATOR 

ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

"Restricted  Rights  Legend" 

--  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Computer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

--  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

with  Storage.Jlanager_Sequential ; 
package  body 

Map_Sinple_JJoncached_Sequent ial_UnboundecUManaged_I terator  is 

type  Node  is 
record 

The_Doinain  :  Domain; 

The_Range  :  Ranges ; 

Next  :  Structure; 

end  record; 

procedure  Free  (The_Node  :  in  out  Node)  is 
begin 

null; 
end  Free; 

procedure  SetJtJext  {The_^ode  :  in  out  Node; 

To^Next  :  in  Structure)  is 

begin 

The_Node.Next  To_Next; 
end  Set_Next; 

function  Next_Of  (The_Node  :  in  Node)  return  Structure  is 
begin 

return  The__Node ,  Next ; 
end  Next_Of  ; 

package  Node_Manager  is  new  Storage_Manager_Seguential 

(Item  =>  Node, 

Pointer  =>  Structure, 

Free  =>  Free, 

Set_Pointer  =>  Set_Next, 
Pointer_Of  =>  Next_Of ) ; 

procedure  Find  {The_Doinain  :  in  Domain; 

InJThe Jlap  ;  in  Map  ; 

The_Bucket  :  out  Positive; 

Previous JJode  :  in  out  Structure; 

Current_Node  ;  in  out  Structure)  is 

Tenporary_Bucket  :  Positive 

(Hash_Of  (The_Domain)  mod 

Nuinber_Of_Buckets )  +  1; 
begin 

The_Bucket  Teirporary_Bucket  ; 

Current_Node  :=  ln^The_Map  (Ten5>orary_Bucket )  ; 
while  Current_Node  /=  null  loop 

if  Current_Node  .The_Doinain  =  The_Domain  then 
return; 

else 

Previous_Node  : =  Current_Node ; 

Current  JNode  :=  Current_Node . Next ; 
end  if; 
end  loop; 
end  Find; 

procedure  Copy  ( Fr om_The_Map  :  in  Map; 

To_The_Map  :  in  out  Map)  is 
From_Index  :  Structure; 

To_Index  :  Structure; 
begin 

for  Index  in  To_The_Map ' Range  loop 

Node_Manager .Free {To_The_Map( Index) ) ; 

end  loop; 

for  Index  in  Froit\_The_Map '  Range  loop 
Fronuindex  :=  From_The_Map (Index) ; 
if  From_The_Map ( Index)  /=  null  then 

To_Thejaap  (Index)  :=  Node^Manager  .New_Item; 

To_The_Map  { Index )  .  The_Domain  :  =  From_Index .  The_Domain ; 
To_The_Map ( Index ). The_Range  :=  Froin_Index.The_Range; 
To_Index  :=  To„The_Map  ( Index)  ; 

From_Index  :=  FronL.Index.Next ; 
while  Fronuindex  /=  null  loop 

To_Index.Next  :=  Node__Manager.New„Item; 
To_Index.Next.The_Domain  :=  FrortuIndex.The_Domain; 
To_Index-Next.The_Range  Fronuindex . The_Range ; 

To_Index  :=  To_lndex.Next ; 

Fronuindex  :=  Fronuindex .  Next  ; 
end  loop; 
end  if; 
end  loop ; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Copy; 


procedure  Clear  (TheJMap  :  in  out  Map)  is 
begin 

for  Index  in  TheJSap ’ Range  loop 

Node_Manager - Free (The„Map( Index) ) ; 
end  loop; 
end  Clear ; 

procedure  Bind  (The_Domain  :  in  Domain; 

And_The_Range  :  in  Reinges ; 

In_The_Map  :  in  out  Map)  is 

The_Bucket  :  Positive; 

Previous^ode  :  Structure; 

Current^Node  :  Structure; 

Tenporary_Node  :  Structure; 
begin 

Find(The_Domain,  In_The_Map,  The_Bucket,  Previous JNode , 
CurrentJJode) ; 

if  CurrentJJode  /=  null  then 
raise  Multiple_Binding; 

else 

Tenporary_Node  ;=  Node_Nanager  .New_It^; 
Tenporary^Node .  The^Domain  :  :=  The_Domain ; 
Tenporary_Node .  The^Range  ;  =  And_The_Reuige  ; 
TenporaryJNode - Next  : =  In_The_Map ( The_Bucke t ) ; 
In_The_Jiap  ( The_Bucke  t )  :  =  Tertpor ary_Node ; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Bind; 

procedure  Unbind  (The_Domain  :  in  Domain; 

In_TheJMap  ;  in  out  Map)  is 
The_Bucket  :  Positive; 

Previous_Node  ;  Structure; 

Current^ode  :  Structure  ; 
begin 

Find(The„Domain,  In_The_Map,  The^Bucket,  Pr evious^Node , 
Current_Node )  ; 

if  Previous^ode  =  null  then 

In_The_Map  (The_Bucket)  :=  Current_Node .Next ; 

else 

Previous_Node.Next  ;=  Current_Node.Next ; 
end  if; 

Cur rent_Node .Next  :=  null; 

Node^Manager . Free (Current_Node) ; 
exception 

when  Constraint_Error  =:> 

raise  Domain_IsJNot_Bound; 
end  Unbind; 

—  modified  by  Tuan  Nguyen  and  Vincent  Hong 

—  date;  8  April  1995 

—  adding  procedures  to  replace  fxjnctions 

procedure  Is_Equal  (Left  :  in  Map; 

Right  :  in  Map; 

Result  ;  out  Boolean)  is 

begin 

Result  ;=  Is_Egual (Left, Right ) ; 
end  Is_Equal; 

procedure  Extent_0f  (The_Map  ;  in  Map; 

Result  :  out  Natural)  is 

begin 

Result  :=  Extent_Of (The_Map) ; 
end  Extent^Of; 

procedure  Is_Eirpty  (TheJSlap  ;  in  Map; 

Result  :  out  Boolean)  is 

begin 

Result  : =  Is_Empty ( TheJMap ) ; 
end  Is_Eitpty; 

procediare  Is_Bound  (The^Domain  :  in  Domain; 

In_The_Map  :  in  Map; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is_Bound(The_Domain,In_The^Map) ; 
end  Is_Bound; 

procedure  Range^Of  (The_Doinain  :  in  Domain; 

ln_The_Map  :  in  Map; 

Result  ;  out  Ranges)  is 

begin 

Resu It  : =  Range_Of ( The JDomain , In_The_Map ) ; 
end  Range_Of ; 

—  end  of  modification 

function  Is.^Equal  (Left  ;  in  Map; 

Right  :  in  Map)  return  Boolean  is 
Left^Index  ;  Structure; 

Right_Index  :  Structure; 

Left_Count  :  Natural; 

Right_Co^lnt  :  Natural; 
begin 
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for  Index  in  Left ’Range  loop 

if  (Left (Index)  =  null)  xor  (Right (Index)  =  null)  then 
return  False; 

else 

Left_Index  : *  Lef t ( Index) ; 

Lef t_Count  : =  0 ; 

while  Left_lndex  /«  null  loop 

Right_Index  :=  Right ( Index) ; 
while  Right_Index  /=  null  loop 
if  (Left_Index.The_Doinain  = 

Right_Index.The_Domain)  then 
exit; 

else 

Right_Index  :=  Right_Index.Next; 
end  if; 
end  loop; 

if  Left_Index.The_Range  /=  Right_Index - The_Range 

then 

return  False; 

else 

Le f t_Index  : =  Lef t_Index . Next ; 

Left_Count  :=  Left_Count  +  1; 
end  if; 
end  loop; 

Right_Index  :=  Right (Index) ; 

Right_Count  ;=  0; 

while  Right_lndex  /=  null  loop 

Right_Index  :=  Right_Index.Next ; 

Right_Count  :=  Right_Count  +  1; 
end  loop; 

if  Left_Count  /=  Right_Count  then 
return  False; 
end  if; 
end  if; 
end  loop; 
return  True; 
exception 

when  Const  rain  t__Error  => 
return  False; 
end  Is_Equal; 

function  Extent_Of  (The_Nap  :  in  Map)  return  Natural  is 
Count  ;  Natural  :=  0; 

Tentporau:y_Node  :  Structure  ; 

Ijegin 

for  Index  in  The_Map '  Range  loop 

Teinporary_Node  :=  The^Nap  ( Index)  ; 
while  Tenporary^ode  I-  null  loop 
Count  ;=  Count  +  1; 

Teinporai:y_JJode  :  =  Teirpor aryJMode ,  Next ; 
end  loop; 
end  loop; 
return  Count; 
end  Extent_Of; 

function  Is_Einpty  (The_Map  :  in  Map)  return  Boolean  is 
begin 

return  (TheJMap  =  Map' (others  =>  null)); 


end  Is^Empty; 

fianction  Is_Bound  (The_I)omain  :  in  Domain; 

In_The_Nap  ;  in  Map)  return  Boolean  is 
The_Bucket  :  Positive; 

Previous_Node  :  Structure; 

Current^ode  :  Structure; 
begin 

Find(The_Domain,  In_The^ap,  The_Buc)cet,  Previous_Node, 
Current JNode )  ; 

return  ( Current JNode  f~  null) ; 
end  Is_Bound; 

function  Range^Of  (The_Doinain  :  in  Domain; 

In_The_Map  :  in  Map)  return  Ranges  is 
The_Bucket  :  Positive; 

Previous Jlode  ;  Structure; 

Current_JJode  :  Structure; 
begin 

Find(The_Doinain,  In_The_Map,  The^Bucket,  Previous_Node, 
Current_Node)  ; 

return  Current JJode . The_Range ; 
exception 

when  Constraint_Error  => 

raise  Domain_Is_Not_Bound; 
end  Range_0f; 

procedure  Iterate  (Over_.The_Jlap  :  in  Map)  is 

The_JBucket  :  Positive  ;=  Over_The_Map’Last; 

The_Node  :  Structure; 

Continue  :  Boolean; 

begin 

for  The^lterator  in  Over_The_Map ' Range  loop 

if  Over„The_Nap{The_lterator)  /-  null  then 
The^Bucket  ;=  The_Iterator; 

The^Node  : =  Over_The_Map ( The_I ter a  tor ) ; 
exit; 
end  if; 
end  loop; 

while  The_Node  /=  null  loop 

Process ( The_Node . The_Doma in ,  The_Node . The_Range , 

Continue) ; 

exit  when  not  Continue; 

TheJ^ode  :=  The  JNode  .Next; 
if  The JNode  =  null  then 

for  The_lterator  in  (The^Bucket  +1)  . . 
Over_TheJlap'Last  loop 

if  Over_The_Map(The_Iterator)  /=  null  then 
The_Bucket  :=  The_Iterator; 

The_Node  :=  Over_The_flap(The_Iterator)  ; 
exit  ; 
end  if; 
end  loop; 
end  if; 
end  loop; 
end  Iterate; 

end  Map_,SinpleJNoncachecLSequent ial_Unboxanded^_Managed_Iterator ; 
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MAP  SIMPLE  NONCACHED  SEQUENTIAL  UNBOUNDED  MANAGED  ITERATOR 

PSDL 


TYPE  Map_Sirnple_Noncached^Sequential_Unbounded_Managed^Iterator 

SPECIFICATION 

GENERIC 

Domain  :  PRIVATE_TYPE, 

Ranges  :  PRIVATE_TYPE, 

Hash  Of  :  FUNCTION lThe_Domain  ;  Domain,  RETURN  ;  Positive] , 
Hashlof  :  PROCEDURE  {The_Doinain  :  intt  :  Domain],  Result  :  out  It  : 
Positive] ] 

OPERATOR  Copy 
SPECIFICATION 
INPUT 

FroiruThe JMap  :  Map , 

To_The_JIap  :  Map 
OUTPUT 

To_The  Jlap  ;  Map 
EXCEPTIONS 

Overflow,  Domainal s_Not_Bound,  Multiple^Binding 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The^Map  :  Map 
OUTPUT 

The_Map  :  Map 
EXCEPTIONS 

Overflow,  Doinain_Is_Not_Bound,  Multiple_Binding 

END 

OPERATOR  Bind 
SPECIFICATION 
INPUT 

The^Domain  ;  Domain, 

Andjrhe_Range  ;  Ranges, 

In_The_Map  :  Map 
OUTPUT 

In_The_Map  :  Map 
EXCEPTIONS 

Overflow,  Domain_Is_Not_Bound,  Multiple_Bindxng 

END 

OPERATOR  Unbind 
SPECIFICATION 
INPUT 

The_Domain  :  Domain, 

In_The_Map  :  Map 
OUTPUT 

In_The_Map  ;  Map 
EXCEPTIONS 

Overflow,  Domain„Is_Not_Boiind,  Multiple_Binding 

END 

OPERATOR  lS_Equal 
SPECIFICATION 
INPUT 

Left  :  Map, 

Right  :  Map 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 


Overflow,  Domain_Is_Not_Bo\md,  Multiple_Binding 

END 

OPERATOR  Extent^Of 

SPECIFICATION 

INPUT 

TheJMap  :  Map 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Domain_Is_Not_Bound,  Multiple_Binding 

END 

OPERATOR  Is_Empty 

SPECIFICATION 

INPUT 

The_Map  :  Map 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Domain_Is^ot_Bound,  Multipl€_Binding 

END 

OPERATOR  Is^Boiind 

SPECIFICATION 

INPUT 

The_Doinain  ;  Domain, 

In_TheJMap  :  Map 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Domain_Is_Not_Bound,  Multiple_Binding 

END 

OPERATOR  Range_Of 

SPECIFICATION 

INPUT 

The_Domain  :  Domain, 

In_The_Map  ;  Map 
OUTPUT 

Result  :  Ranges 
EXCEPTIONS 

Overflow,  Domain_Is_Not_Bound,  Multiple_Binding 

END 

OPERATOR  Iterate 

SPECIFICATION 

GENERIC 

Process  :  PROCEDURE [The_Domain  :  in[t  :  Domain],  The_Range 
in[t  :  Ranges],  Continue  :  out[t  :  Boolean]] 

INPUT 

Over_TheJMap  :  Map 
EXCEPTIONS 

Overflow,  Doniain_Is_Not_Bound,  Multiple_Binding 

END 

END 

IMPLEMENTATION  ADA 

Map_Siiiple_Noncached_Sequential_Unbounde<i_Managed^Iterator 

END 
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MAP  SIMPLE  NONCACHED  SEQUENTIAL  UNBOUNDED  UNMANAGED  NONITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Domain  is  private; 
type  Ranges  is  private; 

Number_Of_Buckets  :  in  Positive; 

with  function  Hash-Of  {The_Domain  :  in  Domain)  return  Positive; 

—  modified  by  Tuan  Nguyen  and  Vincent  Hong 

—  date:  8  ;^ril  1995 

adding  procedures  to  replace  functions 

with  procedure  Hash_Of  {The_Domain  :  in  Domain; 

Result  :  out  Positive) ; 

—  end  of  medication 
paclcage 

Map_Simple_Noncached_Sequential_Unbounded_UninanagedJ^oniterator  is 

type  Map  is  limited  private; 

procedure  Copy  (FroirL_The_Map  :  in  Map; 

To_Th€_Map  ;  in  out  Map)  ; 

procedure  Clear  (The_Map  :  in  out  Map) ; 

procedure  Bind  (The_Domain  ;  in  Domain; 

And_The_Range  :  in  Ranges; 

In_The_Map  :  in  out  Map)  ; 

procedure  Unbind  (The_Domain  :  in  Domain; 

In_The_Map  :  in  out  Map) ; 

—  modified  ty  Tuan  Nguyen  and  Vincent  Hong 

—  date:  8  April  1995 

adding  procedures  to  replace  functions 

procedure  Is_Egual  (Left  :  in  Map; 


Right  ;  in  Map; 

Result  :  out  Boolean) ; 
procedure  Extent_Of  (The_Map  :  in  Map; 

Result  :  out  Natural); 

procedure  Is_Eitpty  (TheJKap  :  in  Map; 

Result  :  out  Boolean) ; 
procedure  Is_Bound  (The_Domain  :  in  Domain; 

In_The_Map  :  in  Map; 

Result  :  out  Boolean) ; 

procedure  Rcinge_^Of  (The_Domain  ;  in  Domain; 

ln_The_Map  :  in  Map; 

Result  :  out  Ranges) ; 

—  end  of  modication 

fxanction  Is_Equal  (Left  :  in  Map; 

Right  :  in  Map)  retxim  Boolean; 

fvinction  Extent_Of  (TheJMap  :  in  Map)  return  Natural; 

fxinction  Is_Empty  (The_Map  :  in  Map)  return  Boolean; 

function  Is^Bound  {The_Domain  :  in  Domain; 

In_The_Map  :  in  Map)  return  Boolean; 
function  Range_Of  (The_Domain  :  in  Domain; 

In_The_Map  :  in  Map)  return  Ranges; 

Overflow  :  exception; 

Domain_IsJMot_Bound  :  exception; 

Mul tiple^B inding  :  exc ep t ion ; 

private 

type  Node; 

type  Structure  is  access  Node; 

type  Map  is  array  (Positive  range  1  ..  Number_Of_Buckets )  of 
Structure; 

end  Map_S  imp  le_NoncachedLSeguen  t  ial_Unbormde<LUninanaged^oni  t era t or 


109 


MAP  SIMPLE  NONCACHED  SEQUENTIAL  UNBOUNDED  UNMANAGED  NONITERATOR 

ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3)  (ii) 
—of  the  rights  in  Technical  Data  and  Computer 

--  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

--  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 


package  body 

Map_Simple_Noncached_Sequential_Unbounded_Unmanaged_Noniterator  rs 

type  Node  is 
record 

The_Doinain  :  Domain; 

The_Range  :  Reinges  ; 

Next  :  Structure; 

end  record; 


procedure  Find  (The_Doinain  :  in  Domain; 

In_The_Map  :  in  Map; 

The_Bucket  :  out  Positive; 

Previous_Node  :  in  out  Structure; 

Current_Node  ;  in  out  Structure)  is 

Temporary_Bucket  :  Positive  := 

(Hash^Of  (The^Domain)  mod 

Number_Of_Buckets)  +  1; 
begin 

The_Bucket  :=  Temporary_Bucket ; 

Current^ode  :=  In_TheJlap  (Teinporary_Bucket)  ; 
while  CurrentJMode  l~  null  loop 

if  Current_Node.The_Domain  =  The_Domain  then 
return; 

else 

Previous_Node  :  =  Current_J^ode ; 

Current_Node  :=  Current_Node.Next; 
end  if; 
end  loop; 
end  Find; 

procedure  Copy  ( From_The_Map  ;  in  Map; 

To_The_Jiap  ;  in  out  Map)  is 
Fronuindex  ;  Structure; 

To_Index  ;  Structure; 
begin 

for  Index  in  FroituTheJMap  *  Range  loop 
Fronuindex  :=  FrorruThe_Map  { Index ) ; 
if  FronuThe_Map( Index)  =  null  then 
To_'Ihe_Map( index)  ;*  null; 

else 

To_The_Map( Index)  :=  new  Node* 

(The_Domain  => 

From_Index ,  The_Domain, 

The_Range  => 

From_Index .  The_Range , 

Next  =>  null) ; 

To_Index  :=  To_TheJMap { Index ) ; 

Fronuindex  :=  FronuIndex.Next; 
while  From_Index  /=  null  loop 
To^Index .  Next  :  =  new  Node  ' 

(The_Domain  => 

Froirt,Index .  The__Domain, 

The_Range  => 

From_Index .  The_Range ,  _ 

Next  =>  null) ; 

To_Index  :=  To_Index.Next ; 

From_Index  :=  From_Index.Next; 
end  loop; 
end  if; 
end  loop; 
exception 

when  Storage_Error  ==> 
raise  Overflow; 
end  Copy; 

procedure  Clear  (The^Map  :  in  out  Map)  is 
begin 

The_Map  :=  Map* (others  =>  null) ; 
end  Clear; 


procedure  Bind  {The_Domain  :  in  Domain; 

AndLThe_Range  :  in  Ranges ; 

In_The_Map  :  in  out  Map)  is 

The_Bucket  ;  Positive; 

Previous JNode  :  Structure; 

Cur rent JNode  :  Structure; 
begin 

Find(The_Domain,  In^TheJMap,  The_Bucket,  Previousjlode, 
Current  Jlode ) ; 

if  Current  JNode  /=  null  then 
raise  Multiple_Binding ; 

else 

In_‘rhe_Map{The_Bucket)  :=  new  Node* 


(The^Domain  =>  The_Domain, 
The^Range  =>  And_The_Range, 
Next  => 

In_The_>iap(The_Bucket) ) ; 
end  if; 
exception 

when  storage_Error  -> 
raise  Overflow; 
end  Bind; 

procedure  Unbind  (The^Domain  :  in  Domain; 

In^'The.Map  :  in  out  Map)  is 
The_Bucket  :  Positive; 

Previous JJode  :  Structure; 

Current_Node  :  Structure; 
begin 

Find(The_Domain,  IrjThe^Map,  The_Bucket,  Previous_Mode , 
Current_Node )  ; 

if  Previous^ode  =  null  then 

In_The_Map  (The_Bucket)  :=  Current^Node.Next ; 

else 

]Previous_Node.Next  :=  Curren t JNode. Next ; 
end  if; 
exception 

when  Constraint_Error  => 

raise  Domain.„IsJNot_Bound; 
end  Unbind; 

—  modified  by  Tuan  Nguyen  and  Vincent  Hong 

—  date:  8  April  1995 

adding  procedures  to  replace  functions 

procedure  Is_Egual  (Left  :  in  Map; 

Right  :  in  Map; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is_Equal (Left, Right) ; 
end  Is_Equal; 

procedure  Extent^Of  (Thejlap  :  in  Map; 

Result  :  out  Natural)  is 

begin 

Result  :=  Extent_Of (The_Map) ; 
end  Extent_Of; 

procedure  Is_En^ty  (The_Map  :  in  Map; 

Result  ;  out  Boolean)  is 

begin 

Result  Is_Enpty (The_Map} ; 
end  Is_Eii5Jty; 

procedure  Is„Bound  (The_Domain  :  in  Domain; 

In_TheJMap  :  in  Map; 

Result  ;  out  Boolean)  is 

begin 

Result  :  =  Is_Bound  { The_Domain ,  In_The_Map )  ; 
end  Is_Bound; 

procedure  Range^Of  (The_Domain  :  in  Domain; 

In_The_Map  ;  in  Map; 

Result  ;  out  Ranges)  is 

begin 

Result  :=  Range_Of  (TheJDomain,  In_The_^ap)  ; 
end  Range_0f; 

—  end  of  modification 

function  Is_Equal  (Left  :  in  Map; 

Right  :  in  Map)  return  Boolean  is 
Left_Index  :  Structure; 

Right_Index  :  Structure; 

Left_Count  :  Natural; 

Right_Count  :  Natural; 
begin 

for  Index  in  Left 'Range  loop 

if  (Left (Index)  =  null)  xor  (Right (Index)  =  null)  then 
return  False; 

else 

Left^Index  :=  Left ( Index) ; 

Left_Count  :=  0; 

while  Left_Index  /=  null  loop 

Right_Index  :*  Right (Index) ; 
while  Right_Index  /=  null  loop 
if  (Left_Index.The_Domain  = 

Right^Index . The_Domain )  then 
exit; 

else 

Right_Index  :=  Right_Index.Next; 
end  if; 
end  loop; 

if  Left_Index.The_Range  /=  Right_Index.The_Range 

then 

return  False; 

else 

Left_Index  ;=  Lef t_Index.Next ; 

Left_Count  :=  Left_Count  +  1; 
end  if; 
end  loop; 


no 


Right_lndex  ; =  Right ( Index ) ; 

Right_Count  :=  0; 

while  Right^Index  /«  null  loop 

Right_Index  :=  Right_Index . Next ; 
Right_Count  :=  Right^Count  +  1; 
end  loop; 

if  Left_Count  I-  Right^Count  then 
return  False; 
end  if; 
end  if; 
end  loop; 
return  True; 
exception 

when  Constraint_Error  => 
return  False; 
end  Is_E<iual ; 

function  Extent_Of  {The_Map  :  in  Map)  return  Natural  is 
Count  :  Natural  :=  0; 

TenqporaryJMode  :  Structure; 
begin 

for  Index  in  The^Map ' Range  loop 

Terrporary_Node  ;=  The_Map  ( Index)  ; 
while  Temporary_Node  /=  null  loop 
Count  :=  Count  +  1; 

Teit5)orary_JIode  :=  Teii:5)orary_Node  .Next  ; 
end  loop; 
end  loop; 
return  Count; 
end  Extent_Of; 


function  Is^Enpty  (TheJMap  :  in  Map)  return  Boolean  is 
begin 

return  {The_Map  =  Map* (others  =>  null)); 
end  Is_Errpty; 

fimction  Is__Boiind  {The_Domain  :  in  Domain; 

In^TheJMap  :  in  Map)  return  Boolean  is 
The_Bucke  t  :  Pos i t ive ; 

Previous_Node  ;  Structure; 

Current_Node  ;  Structure; 
begin 

Find(The_Domain,  In_The_Map,  The_Buclcet,  Previous_Node, 
CurrentJIode) ; 

return  (Current^ode  /=  null)  ; 
end  Is^Bound; 

f\mction  Range_Of  (The_Domain  :  in  Domain; 

In_The_Map  :  in  Map)  return  Ranges  is 
The__Bucket  :  Positive; 

PreviousJNode  :  Structure; 

Current_Node  :  Structure; 
begin 

Find{The_Domain,  In_The_Map,  The_Bucket,  PreviousJ^ode, 
Current JMode ) ; 

re  turn  Cur r ent_Node . The_Range ; 
exception 

when  Cons train t_Err or  => 

raise  Doinain_Is_No  t_Bound  ; 
end  Range_Of; 

end  Map_Simple_Noncached_Seguent  ial_Unbounded_UniTianaged_Noni  terator 
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MAP  SIMPLE  NONCACHED  SEQUENTIAL  UNBOUNDED  UNMANAGED  NONITERATOR 


PSDL 


TYPE  Map_Siittple_Noncached^Seqaential_UnboundecL.Uninanaged^oniterator 

SPECIFICATION 

GENERIC 

Domain  :  PRIVATE_TYPE , 

Ranges  :  PRIVATE.TYPE,  .  . 

Hash_Of  :  FUNCTION [The_Domain  :  Domain,  RETURN  :  Positive], 
Hash_Of  :  PROCEDURE [The_Doma in  ;  in It  :  Domain],  Result  :  out[t  : 
Positive] ] 

OPERATOR  Copy 
SPECIFICATION 
INPUT 

FronL,The_Map  :  Map , 

To_The^ap  :  Map 
OUTPUT 

To_The_Map  ;  Map 
EXCEPTIONS 

Overflow,  Domainal sJTot_Bound,  Multiple_Binding 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Map  :  Map 
OUTPUT 

The_Map  :  Map 

EXCEPTIONS  . 

Overflow,  Domain_IsJJot_Bound,  Multiple^Binding 

END 

OPERATOR  Bind 
SPECIFICATION 
INPUT 

The_Doinain  :  Domain, 

AncLTh€_Range  :  Ranges, 

In_TheJlap  :  Map 
OUTPUT 

In_The  Jlap  :  Map 
EXCEPTIONS 

Overflow,  Domain_Is_Not_Bound,  Multiple_Binding 

END 

OPERATOR  Unbind 
SPECIFICATION 
INPUT 

The_Doinain  :  Domain, 

In^The_Map  :  Map 
OUTPUT 

In_The_Map  :  Map 
EXCEPTIONS 

Overflow,  Domain_Is_Not_Bound,  Multiple_Binding 

END 

OPERATOR  Is_Equal 
SPECIFICATION 
INPUT 


Left  :  Map, 

Right  :  Map 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Domain_Is_Not_Bound,  Multiple^Binding 

END 

OPERATOR  Extent_Of 

SPECIFICATION 

INPUT 

TheJMap  :  Map 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Domain_IsJNot_Botind,  Multiple_Binding 

END 

OPERATOR  Is_Ei!ipty 

SPECIFICATION 

INPUT 

The_Map  :  Map 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Domain_Is_Not_Bound,  Multiple_Binding 

END 

OPERATOR  Is_Bound 

SPECIFICATION 

INPUT 

The_Domain  :  Domain, 

In_The_Map  :  Map 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Domain_Is_Not_Botind,  Multiple_Bindang 

END 

OPERATOR  Range^Of 

SPECIFICATION 

INPUT 

TheJ3omain  :  Domain, 

In_The.Jlap  :  Map 
OUTPUT 

Result  :  Ranges 
EXCEPTIONS 

Overflow,  Domain_IsJNot_Bound,  Multiple_Binding 

END 

END 

IMPLEMENTATION  ADA 

Map_Simple_Noncached_Sequential_Unbounded_Unmanaged_Noniterator 

END 
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MAP  SIMPLE  NONCACHED  SEQUENTIAL  UNBOUNDED  UNMANAGED  ITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Domain  is  private; 
type  Ranges  is  private; 

Nuinber_Of_Buckets  ;  in  Positive; 

with  function  Hash_Of  (The_Domain  :  in  Domain)  return  Positive; 

—  modifiecl  by  Tuan  Nguyen  and  Vincent  Hong 

—  date:  8  ;^ril  1995 

adding  procedures  to  replace  functions 

with  procedure  Hash_Of  (The_Domain  :  in  Domain; 

Result  :  out  Positive) ; 

—  end  of  modication 

pac)cage  Map_Siirple_NoncachecLSequential_Unbounded_Unmanaged_Iterator 

is 

type  Map  is  limited  private; 

procedure  Copy  (FroitL,TheJMap  :  in  Map; 

To_TheJKap  :  in  out  Map); 

procedure  Clear  (TheJMap  :  in  out  Map) ; 

procedure  Bind  (The_Domain  :  in  Domain; 

And_The_Range  :  in  Ranges; 

In_TheJMap  :  in  out  Map) ; 

procedure  Unbind  (The^Domain  :  in  Domain; 

In^TheJlap  :  in  out  Map)  ; 

--  modified  by  Tuan  Nguyen  and  Vincent  Hong 

—  date:  8  April  1995 

—  adding  procedures  to  replace  functions 

procedure  Is^Equal  (Left  ;  in  Map; 

Right  :  in  Map; 

Result  :  out  Boolean) ; 
procedure  Extent_Of  (The_J«ap  :  in  Map; 


Result  :  out  Natural); 

procedure  Is_Eirpty  (The_Map  :  in  Map; 

Result  :  out  Boolean) 
procedure  Is_Bound  {The^Domain  ;  in  Domain; 

In_The_Map  :  in  Map; 

Result  :  out  Boolean) ; 

procedure  Range_Of  (The_Domain  :  in  Domain; 

In_The_Map  :  in  Map; 

Result  :  out  Ranges); 

—  end  of  modication 

function  Is_Equal  {Left 

Right 

f\anction  Extent_Of  (Thejlap 

function  Is_Eirpty  {The_Map 

function  Is_Bound  {The_Domain 

In_The_^p 

function  Range_Of  (The_Domain 

In_The_Map 

generic 

with  procedure  Process  (The^Domain  :  in  Domain; 

The_Range  :  in  Ranges ; 

Continue  :  out  Boolean) ; 

procedure  Iterate  (Over_The_Map  :  in  Map) ; 

Overflow  :  exception; 

Domainal s_Not_Bound  :  exception; 

Multiple_Binding  :  exception; 

private 

type  Node; 

type  Structure  is  access  Node; 

type  Map  is  array  {Positive  range  1  ..  Nuinber_Of_Buc)cets )  of 
Structure; 

end  Map_Siiiple JNoncached_Sequential_Unbounded_Unmanaged_I terator ; 


:  in  Map; 

:  in  Map)  return  Boolean; 
:  in  Map)  return  Natural; 
:  in  Map)  return  Boolean; 
:  in  Domain; 

:  in  Map)  return  Boolean; 
:  in  Domain; 

;  in  Map)  return  Rauiges; 
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MAP  SIMPLE  NONCACHED  SEQUENTIAL  UNBOUNDED  UNMANAGED  ITERATOR 

ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

-Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Coirputer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 


package  body 

Map_Siinple^oncachedLSequential_Unbounded_Uninanaged_Iterator  as 


type  Node  is 
record 

The_Domain  :  Domain ; 
The^Range  :  Ranges ; 
Next  :  Structure; 

end  record; 


procedure  Find  {The_Domain  :  in  Domain; 

In_The_Map  :  in  Map; 

The_Bucket  :  out  Positive; 

Previous^ode  :  in  out  Structure; 

Current^Node  :  in  out  Structure)  is 

Teir?>orary_Bucket  :  Positive  :  = 

(Hash_Of  {The_Doniain)  mod 


Numb€r_Of_Buckets)  +  1; 
begin 

The_Bucket  :=  Temporary^Bucket; 

CurrentJMode  :=  In_TheJlap(Teiiporary_Bucket)  ; 
while  Current_;Node  /=  null  loop 

if  Current^Node .  The__Domain  -  The_Domain  then 


return; 

else 

Previous_Node  : =  Current_Node ; 
Current_Node  :=  Cur rent_Node. Next; 
end  if; 
end  loop; 
end  Find; 


procedure  Copy  (Fron\_The_Map  ;  in  Map; 

To_The_Map  :  in  out  Map)  is 
FronL.Index  ;  Structure; 

To_Index  :  Structure; 
begin 

for  Index  in  FronuTheJIap  ‘  Range  loop 
From_Index  :=  From_The_Map  ( Index) ; 
if  FroirL,The_Map{ Index)  =  null  then 
To_The_Jlap  ( Index )  :  =  null  ; 

else 

To_The_Map( Index)  :=  new  Node' 

(The_„Domain  => 

From^Index . The^Domain , 

The_Range  => 

From_lndex . The_Range , 

Next  =>  null) ; 

To_Index  :=  To_The_Map  ( Index)  ; 

From_lndex  :=  Prom_lndex.Next ; 
while  From_Index  /=  null  loop 
To_Index.Next  :=  new  Node' 

(The_Domain  => 

From^lndex . The^Domain , 

The_Range  => 

Fr om_Index . The_Range , 

Next  =>  null) ; 

To^Index  :=  To_ Index. Next ; 

From_Index  :=  From_Index . Next ; 
end  loop; 
end  if; 
end  loop; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Copy; 

procedure  Clear  {The_JIap  :  in  out  Map)  is 
begin 

The_Map  :=  Map' (others  =>  null); 
end  Clear; 

procedure  Bind  {The_Domain  :  in  Domain; 

And^The_Range  :  in  Ranges; 

In_The_Map  :  in  out  Map)  is 

The_Bucket  ;  Positive; 

PreviousJJode  ;  Structure; 

CurrentJ^ode  :  Structure; 
begin 

Find(The_Domain,  In_The_Map,  The_Bucket,  Previous_Node , 
Current_Node ) ; 

if  CurrentJNode  f-  null  then 
raise  Multiple_Binding; 

else 

In_The_Map(The_Bucket)  :=  new  Node' 


(The_Domain  =>  The_Domain, 
'rhe_Range  =>  AncLTlie_Range, 
Next  => 

In_The_Map(The_Bucket) ) ; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Bind; 

procedure  Unbind  (The_Domain  :  in  Domain; 

In_The_Map  ;  in  out  Map)  is 
The_Bucket  :  Positive; 

Previous Jlode  :  Structure; 

Current_Node  :  Structure; 
begin 

Find(The_Domain,  In_The_Map,  The_Bucket,  Previous_Node , 
Current_^ode ) ; 

if  Previous^ode  =  null  then 

In_The^ap  (The^Bucket)  :=  CurrentJNode  .Next  ; 

else 

Previous_Node .Next  :  =  Current_Node  .Next ; 
end  if; 
exception 

when  Constraint_Error  => 

raise  Domain_IsJNot_Bound; 
end  Unbind; 

—  modified  by  Tuan  Nguyen  and  Vincent  Hong 

—  date:  8  April  1995 

—  adding  procedures  to  replace  functions 

procedure  Is_Equal  (Left  :  in  Map; 

Right  ;  in  Map; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is_Equal (Left, Right ) ; 
end  Is_.Equal; 

procedure  Extent_Of  (TheJMap  :  in  Map; 

Result  ;  out  Natural)  is 

begin 

Result  :=  Extent^Of (TheJMap) ; 
end  Extent_Of; 

procedure  Is^En^Jty  (The^Map  :  in  Map; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is_Eirpty(TheJMap)  ; 
end  Is_Empty; 

procedure  Is^Bound  (The_Domain  :  in  Domain; 

In_The_Map  :  in  Map; 

Result  :  out  Boolean)  is 

begin 

Result  : =  I s_Bound ( The_Domain , In_The_Map ) ; 
end  ls_Bound; 

procedure  Range_Of  {The_Doinain  :  in  Domain  ; 

In_The_Jlap  :  in  Map; 

Result  ;  out  Ranges)  is 

begin 

Result  :=  Range_Of (The_Domain,  In_The_Map) ; 
end  Range_Of; 

end  of  modification 

function  Is_Equal  (Left  ;  in  Map; 

Right  :  in  Map)  return  Boolean  is 
Le  f t_Index  :  S  t rue  tur e ; 

Right_Index  :  Structure; 

Lef t_Count  :  Natural ; 

Right_Count  :  Natural ; 
begin 

for  Index  in  Left 'Range  loop 

if  (Left (Index)  =  null)  xor  (Right (Index)  =  null)  then 
return  False; 

else 

Left_Index  :=  Left (Index); 

Left_Count  ;:=  0; 

while  Left^Index  /=  null  loop 

Right_Index  :=  Right (Index) ; 
while  Right^Index  I-  null  loop 
if  (Lef t_Index.The_Domain  = 

Right_Index . The_Domain )  then 
exit; 

else 

Right_lndex  ;=  Right_Index.Next; 
end  if; 
end  loop; 

if  Left_Index.The_Range  /=  Right_Index.The_Range 

then 

return  False; 

else 

Left_Index  :=  Left_Index,Next; 

Left_Co\int  :=  Left^Count  +  1; 
end  if; 
end  loop; 
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Right_Index  :=  Right (Index) ; 

Right_Co'unt  :  =  0  ; 

while  Right_Index  /=  null  loop 

Right_Index  : =  Right_Index  *  Next ; 
Right_Count  :=  Right_Count  +  1; 
end  loop; 

if  Left_Count  /=  Right^Coxant  then 
return  False; 
end  if; 
end  if; 
end  loop; 
return  True; 
exception 

when  Cons train t_Error  => 
return  False; 
end  Is^Egual; 

function  Extent_Of  (The^ap  :  in  Map)  return  Natural  is 
Coxmt  :  Natural  :=  0; 

Ten?>oraryJtJode  ;  Structure ; 
begin 

for  Index  in  The_Map ' Range  loop 

Tempor ary_jaode  :  =  The_Jlap  ( Index ) ; 
while  Ternporary_JJode  null  loop 
Count  :=  Count  +  1; 

TertporcOY-fJode  :=  Teitporary_Node .Next; 
end  loop; 
end  loop; 
return  Count; 
end  Extent_Of; 

function  Is_Ertipty  (The_Map  :  in  Map)  return  Boolean  is 
begin 

return  (The_Map  *=  Map' (others  =>  null) )  ; 
end  Is_Ernpty; 

function  Is^Bound  (The_Doinain  :  in  Domain; 

In_TheJlap  ;  in  Map)  return  Boolean  is 
The_Bucket  ;  Positive; 

Previous_Node  :  Structure; 

CurrentJWode  ;  Structure; 
begin 

Find(The_Domain,  In^TheJJaP/  The^Bucket,  Previous_Node, 
Current JNode ) ; 

return  {CurrentJJode  /=  null) ; 
end  Is_Bound; 


function  Range_Of  (The^Domain  :  in  Domain; 

In_The_Jlap  :  in  Map)  return  Ranges  is 
The_Bucket  :  Positive; 

Previous_Node  :  Structure ; 

Current  JJode  :  Structure; 
begin 

Find(The_Domain,  In_The_Map,  The_Bucket,  Previous^Node, 
Current_Node)  ; 

return  Current JJode . The_Range ; 
exception 

when  Constraint_Error  => 

raise  Domain_Is_Not_Bound; 
end  Range_0f; 

procedure  Iterate  {Over_The_Map  :  in  Map)  is 
The_Bucket  :  Positive  :=  Over_The_Map'Last; 

The_Node  :  Structure; 

Continue  :  Boolean; 

begin 

for  The_Iterator  in  Over_ThejMap ’ Range  loop 
if  Over_The_Map(The_Iterator)  /=  null  then 
The_.Bucket  The__Iterator; 

The^ode  :  =  Ove  r_The.Jlap  ( The_I  t  era  tor )  ; 
exit; 
end  if; 
end  loop; 

while  The_Node  /=  null  loop 

Process { The JJode . The_Domain ,  The Jlode . The_Range , 

Continue) ; 

exit  when  not  Continue; 

The_Node  :=  TheJJode.Next; 
if  The_Node  =  null  then 

for  The_Iterator  in  (The_Bucket  +1)  . . 
Over_The_Map*Last  loop 

if  Over_TheJMap{The_Iterator)  /=  null  then 
The_Bucket  ;=  The_Iterator ; 

The Jlode  ; =  Over_The_Map ( The_I terator ) ; 
exit; 
end  if; 
end  loop; 
end  if; 
end  loop; 
end  Iterate; 

end  Map_Sirr?>le_NoncachedLSequential_Unbounded_Unmanaged_I terator ; 
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MAP  SIMPLE  NONCACHED  SEQUENTIAL  UNBOUNDED  UNMANAGED  ITERATOR 


PSDL 


TYPE  Map_Siinple_Noncached_Sequential_Unbounded_Uninanaged_Iterator 

SPECIFICATION 

GENERIC 

Domain  :  PRIVATE_TYPE, 

Ranges  :  PRrVATE_TYPE, 

HashuOf  :  FUNCTION [The.Domain  ;  Domain,  RETU^  :  Positive], 
Hash_Of  :  PROCEDURE  [The_Domain  :  init  :  Domain],  Result  :  out  It 
Positive] ] 

OPERATOR  Copy 
SPECIFICATION 
INPUT 

From_The_JNap  ;  Map , 

To_The_Jlap  :  Map 
OUTPUT 

To_The_Map  ;  Map 

EXCEPTIONS  .  ^  o- 

Overflow,  Domain_Is_Not_Bound,  Multiple_Binding 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Map  ;  Map 
OUTPUT 

The_JIap  :  Map 

EXCEPTIONS  ,  .  ^ 

Overflow,  Doinain^Is_Not^Bound,  Multiple^Binding 

END 


OPERATOR  Bind 
SPECIFICATION 
INPUT 

The_Domain  :  Domain, 
AncLThe_Range  :  Ranges, 
In_TheJ«ap  ;  Map 
OUTPUT 

In_The_>Iap  :  Map 
EXCEPTIONS 

Overflow,  Domain_IsJJot_Bound, 

END 


Multiple_Binding 


OPERATOR  Unbind 
SPECIFICATION 
INPUT 

The^Domain  :  Domain, 

In_The_Map  :  Map 
OUTPUT 

In_TheJlap  :  Map 
EXCEPTIONS 

Overflow,  Domain_Is_Not_Bound, 

END 


Multiple^Binding 


OPERATOR  Is_Equal 
SPECIFICATION 
•INPUT 

Left  ;  Map, 

Right  :  Map 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 


Overflow,  Domain_Is_Not_Bound,  Multiple_Binding 

END 

OPERATOR  Extent_Of 
SPECIFICATION 

nmn* 

The_Map  :  Map 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Domain_Is_Not_Bound,  Multiple_Binding 

END 

OPERATOR  Is_Empty 
SPECIFICATION 
INPUT 

The_Map  :  Map 
OUTPUT 

Result  ;  Boolean 

EXCEPTIONS  .  ,  . 

Overflow,  Domain_Is_Not_Botind,  Multiple_Binding 

END 


OPERATOR  IS_Bound 
SPECIFICATION 
INPUT 

The^Domain  :  Domain, 

In_TheJMap  :  Map 
OUTPUT 

Result  :  Boolean 

EXCEPTIONS  . 

Overflow,  Domain_Is_Not_Bound,  Multiple_Binding 

END 


OPERATOR  Range_Of 
SPECIFICATION 
INPUT 

The^Domain  :  Domain, 

In_The_Map  :  Map 
OUTPUT 

Result  :  Ranges 
EXCEPTIONS 

Overflow,  Domain_Is_Not^Bound, 

END 


Mul tiple_Binding 


OPERATOR  Iterate 
SPECIFICATION 
GE2TE1HXO 

Process  :  PROCEDURE [The^Domain  ;  in[t  :  Domain],  The^Range  : 
in[t  :  Ranges],  Continue  :  out[t  :  Boolean]] 

INPUT 

Over_The_^p  :  Map 

EXCEPTIONS  .  ... 

Overflow,  Domain.....ls_Not_Bound,  Multiple_Binding 

END 


END 

IMPLEMENTATION  ADA  ^ 

Map_Siiiple_Nonc  ached_Sequen  t  ia  l_Unbouiide<l_Unmanaged_I  ter  a  tor 
END~ 
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QUEUES  0BJ3  SPECIFICATION 


obj  QUEUE [X  TRIV]  is  sort  Queue  . 
protecting  NAT  . 
subsorts  NzNat  <  Nat  . 

***  constructors 


op  create  ;  ->  Queue  . 

op  copy  :  Queue  Queue  ->  Queue  . 

op  clear  :  Queue  ->  Queue  . 

op  add  :  Elt  Queue  ->  Queue  . 

op  pop  :  Queue  ->  Queue  . 

op  removeitem  ;  Queue  NzNat  ->  Queue  . 


***  accessors 


op  isequal  :  Queue  Queue  ->  Bool  . 

op  lengthof  :  Queue  ->  Nat  . 

op  isenpty  :  Queue  ->  Bool  . 

op  frontof  :  Queue  ->  Elt  . 

op  positionof  :  Elt  Queue  ->  Nat  . 

***  exceptions 

op  overflow  :  ->  Queue  . 

op  underflow  ;  ->  Queue  . 

op  underflow  ;  ->  Elt  . 

op  positionerror  :  ->  Nat  . 

***  variables  declarations 


var  Q  Q1 


Queue  . 


var  E  El  :  Elt  . 

var  P  :  NzNat  - 

***  axioms 

eq  copy(Q,Ql)  =  Q  . 

eq  clear (Q)  =  create  . 

eq  pop (create)  =  underflow  . 

eq  pop (add{E,Q) )  =  if  Q  ==  create  then  create  else  add(E,pop(Q) )  fi 


eq  remove! tern (cr eate, P)  *  underflow  . 

eq  removeitem(add(E,Q) ,P)  =  if  P  ==  lengthof (Q)  +  1  then  Q  else 
add(E,removeitem{Q,P) )  fi  . 

eq  isec[ual(Q,Ql)  =  Q  ==  Q1  . 

eg  lengthof (Q)  =  if  Q  ==  create  then  0  else  1  +  lengthof (pop (Q) )  fi 
eq  iseirpty(Q)  =  Q  ==  create  . 
eq  frontof (create)  =  underflow  . 

eq  frontof (add (E,Q) )  =  if  q  ==  create  then  E  else  frontof (Q)  fi  . 
eg  positionof (E, create)  =  positionerror  . 

eq  positionof (E, add(El, Q) )  =  if  E  ==  El  then  lengthof (Q)  +  1  else 
positionof (E,Q)  fi  . 

endo 
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QUEUES  PROFILE  CODES 


OPERATORS 

SIGNATURES 

PROFILE  CODES 

COPY 

AB->B 

3211 

CLEAR 

A->A 

2201 

ADD 

AB->B 

3211 

POP 

A->  A 

2201 

REMOVE_ITEM 

AB->  A 

3211 

IS_E0UAL 

AB->C 

330 

LENGTH_OF 

A->B 

220 

IS.EMPTY 

A->B 

220 

FRONT.OF 

A->B 

220 

POSmON.OF 

A->B 

220 

SET  OF  PROFILE:  {321 1,2201,330,220} 
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QUEUE  NONPRIORITY  BALKING  SEQUENTIAL  BOUNDED  MANAGED  ITERATOR 

ADA  SPECIFICATION 


generic 

type  Item  is  private; 

package  Queue„Nonpriority_Balking_Sequential_Bounded_Managed_Iterator 
is 


type  Queue (The_Size  :  Positive)  is  limited  private; 


procedure  Copy 

procedure  Clear 
procedure  Add 

procedure  Pop 
procedure  Remove^Item 


( Fromjrhe^Queue 

in 

Queue ; 

To_The_Queue 

in 

out 

Queue) ; 

( The_Queue 

in 

out 

Queue) ; 

(The_Item 

in 

Item; 

To_The_Queue 

in 

out 

Queue ) ; 

(The__Queue 

in 

out 

Queue) ; 

{ Froin_The_Queue 

in 

out 

Queue ; 

A t_The_Pos i t i on 

in 

Positive) ; 

modified  by  Tuan  Nguyen 
replacing  functions  with  procedures 


procedure  Is_Equal 


procedure 

procedure 

procedure 

procedure 


Length_Of 

Is^Enpty 

Front_Of 

Position^Of 


(Left 

Right 

Result 

(The_Queue 

Result 

(The__Queue 

Result 

(The_Queue 

Result 

(The_Item 

InL.The_Queue 


in  Queue; 
in  Queue; 
out  Boolean) ; 
in  Queue; 
out  Natural) ; 
in  Queue; 
out  Boolean) ; 
in  Queue; 
Item)  ; 
in  Item; 
in  Queue; 


Result 


out  Natural) ; 


end  of  modification 


function  ls_Equal 

f-unction  Length_Of 
function  Is_Eirpty 
function  Front_Of 
f vine  t ion  Position„Of 


(Left 

Right 

(The_Queue 

(The_Queue 

(The_Queue 

(The_Item 

In^The_Queue 


in  Queue; 
in  Queue) 
in  Queue) 
in  Queue) 
in  Queue) 
in  Item; 
in  Queue) 


return  Boolean; 
return  Natural; 
return  Boolean; 
return  Item; 

return  Natural; 


generic 

with  procedure  Process  (The_Item  :  in  Item; 

Continue  :  out  Boolean) ; 
procedure  Iterate  {Over_The_Queue  :  in  C^ieue) ; 


Overflow  :  exception; 
Underflow  :  exception; 
Position_Error  :  exception; 


private 

type  Items  is  array (Positive  range  <>)  of  Item; 
type  Queue (The_Size  :  Positive)  is 
record 

The^Back  :  Natural  :=  0; 

The_Items  :  Items (1  ..  The_Size) ; 
end  record; 

end  Queue_Nonpriority_Balking_Sequential_Bovinded^anagecLIterator ; 
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QUEUE  NONPRIORITY  BALKING  SEQUENTIAL  BOUNDED  MANAGED  ITERATOR 


ADA  IMPLEMENTATION 


(C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 
All  Rights  Reserved 

Serial  Number  0100219 


procedure  Length^Of  (The^Queue  :  in  Queue; 

Result  :  out  Natural)  is 

begin 

Result  : =  Leng th_0 f ( The_Queue ) ; 
end  Length_Of; 


“Restricted  Rights  Legend* 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Con?)Uter 

--  Software  Clause  of  FAR  52.227-7013.  Manufacturer; 

--  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  {1-303-987-1874) 


package  body 

Queue JJonpriority_Balking_Sequential_Bounde<5LManaged_Iterator  xs 

procedure  Copy  (Frotn_The_Queue  :  in  Queue; 

To_The_Queue  :  in  out  Queue)  is 

begin 

if  Froir\_The_Queue . The^Back  >  To_The_Queue,The_Size  then 
raise  Overflow; 

elsif  FrortL.The_Queue .  The^Back  =  0  then 
To_The_Queue . The_Back  :=  0; 

else 

To__The_Queue . The_I terns ( 1  ..  FroitL,The_Queue.The_Back)  :  = 
From_.The_Queue .  The_l  terns  (1  . .  Fron\_The_Queue .  The_Back)  ; 
To_The_Queue . The^Back  : =  Fr om_The_Queue . The_Back ; 
end  if; 
end  Copy; 

procedure  Clear  (The_Queue  :  in  out  Queue)  is 
begin 

The__Queue.The_Back  0; 
end  Clear; 


procedure  Add  (The^Item  :  in  Item; 

To_The_Queue  :  in  out  Queue)  is 

begin 

To_The_Queue.  The_I  terns  (To_The_Queue.The_Back  +1)  ;=  The_Item; 

To_The_Queue.The_Back  :=  To_The_Queue . The_Back  +  1; 
exception 

when  Cons train t_Err or  => 
raise  Overflow; 

end  Add; 

procedure  Pop  (The_Queue  :  in  out  Queue)  is 
begin 

if  The_Queue . The_Back  =  0  then 
raise  Underflow; 

elsif  The_Queue . The_Back  =  1  then 
The_Queue . The_Back  : =  0 ; 

else 

The_Queue . The_I terns { 1  . .  ( The_Queue . The_Back  -  1 ) )  : = 
The_Queue . The_I terns (2  . .  The_Queue . The_Back ) ; 

The_Queue . The_Back  ;=  The_Queue . The_Back  -  1; 
end  if; 
end  Pop; 

procedure  Remove_Item  ( Fr onuThe^Queue  :  in  out  Queue; 

At_The_Position  :  in  Positive)  is 

begin 

if  FroiiL_The_Queue .  The_Back  <  At_The_Position  then 
raise  Position_Error; 

elsif  From_The_Queue.The_Back  /=  At_The_Position  then 
Fr  oirL_The_Queue .  The_I  terns 

{At_The_Position  ..  (FroiiL.The_Queue,The_Back  -1))  ;  = 

FroiiL_The_Queue .  The_l  terns 

( {At_The_Position  +1)  ..  From_The_Queue .The_Back) ; 

end  if; 

From_The_Queue.The_Back  :=  From_The_Queue . The_Back  -  1; 
end  Remove^Item; 


procedure  Is_Enpty  (The_Queue 

Result 

begin 

Result  :  ss  Is_Eiip ty  { The_Queue ) ; 
end  Is_Enpty; 

procedure  Front^Of  (The_Queue 

Result 

begin 

Result  :=  Front_Of (The_Queue) ; 
end  Front_Of; 


in  Queue; 
out  Boolean)  is 


in  Queue; 
Item)  is 


procedure  Position_Of 


(The_Item 

In_The_Queue 

Result 


in  Item; 
in  Queue; 
out  Natural) 


begin 

Result  :=  Position_Of (The_Item, In_The_Queue) ; 
end  Position_Of; 


is 


end  of  modification 


function  Is_Equal  (Left  :  in  Queue; 

Right  :  in  Queue)  return  Boolean  is 

begin 

if  Left .The_Back  /=  Right . The_Back  then 
return  False; 

else 

for  Index  in  1  ..  Left .The_Back  loop 

if  Left.The^Items (Index)  /=  Right .The_I terns (Index) 


then 


end 


return  False; 
end  if; 
end  loop; 
return  True; 
end  if; 

Is_Equal ; 


fiinction  Length_Of  (The_Queue  ;  in  Queue)  return  Natural  is 
begin 

return  The_Queue . The_Back ; 
end  Lengtlx_Of; 


function  Is_Empty  {The_Queue  :  in  Queue)  return  Boolean  is 
begin 

return  (The_Queue.The_Back  =  0) ; 
end  Is_Enipty; 


fame t ion  Front^Of  (The^Queue  :  in  Queue)  return  Item  is 
begin 

if  The_Queue.The_Back  =  0  then 
raise  Underflow; 

else 

return  The_Queue.The_Items(l) ; 
end  if; 
end  Front_Of; 


function  Position_Of  (The_Item  ;  in  Item; 

In_The_Queue  :  in  Queue)  return  Natural  is 

begin 

for  Index  in  1  . .  In_The_Queue.The„Back  loop 

if  In^The_Queue  ,The_I terns  (Index)  =  The_Item  then 
return  Index,- 
end  if; 
end  loop; 
return  0; 
end  Position_Of; 


modified  by  Tuan  Nguyen 
replacing  functions  with  procedures 


procedure  Is_Egual  (Left 
Right 
Result 

begin 

Result  :=  Is_Equal (Left, Right) ; 
end  Is_Equal; 


in  Queue; 
in  Queue; 
out  Boolean)  is 


procedure  Iterate  (Over_The_Queue  :  in  Queue)  is 
Continue  ;  Boolean; 
begin 

for  The_Iterator  in  1  .  .  Over_The_Queue .  The_Back  loop 

Process (Over_The_Queue . The_Items (The_Iterator ) ,  Continue) ; 
exit  when  not  Continue; 
end  loop; 
end  Iterate; 

end  Queue^onpr iori ty_Balking_Sequential^Bounded_Managed_I terator ; 
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QUEUE  NONPRIORITY  BALKING  SEQUENTIAL  BOUNDED  MANAGED  ITERATOR 


PSDL 


TYPE  QueueJ^onpriority_Balking_Sequential_Bounde^Managed_Iterator 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

From_The_Queue  :  Queue, 

To_The_Queue  :  Queue 
OUTPUT 

To_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

Thfi-Queue  :  Queue 
OUTPUT 

■Hie—Queue  ;  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Add 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

To_The_Queue  ;  Queue 
OUTPUT 

To_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow.  Posit ion_Error 

END 

OPERATOR  Pop 
SPECIFICATION 
INPUT 

The^Queue  :  Queue 
OUTPUT 

The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Remove_Item 
SPECIFICATION 
INPUT 

From_The_Queue  :  Queue, 

At_The_Position  :  Positive 
OUTPUT 

From_The_Queue  ;  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Is^Equal 
SPECIFICATION 
INPUT 

Left  :  Queue , 

Right  :  Queue 


OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Length_Of 

SPECIFICATION 

INPUT 

The_Queue  :  Queue 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Is_Eirpty 

SPECIFICATION 

INPUT 

The_Queue  :  Queue 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow,  Posit ion_Error 

END 

OPERATOR  Front_Of 

SPECIFICATION 

INPUT 

The__Queue  :  Queue 
OUTPUT 

Result  :  Item 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Position^Of 

SPECIFICATION 

INPUT 

The_Item  :  Item, 

In_The_Queue  :  Queue 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow,  posit ion_Error 

END 

OPERATOR  Iterate 

SPECIFICATION 

GENERIC 

Process  :  PROCEDURE [The_I tern  ;  in[t  t  Item],  Continue  :  outEt 

Boolean] ] 

INPUT 

Over_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Posit ion_Error 

END 

END 

IMPLEMENTATION  ADA 

Queue^onpriority_Balking_Se<iuential_BoundedJManaged_Iterator 

END 
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QUEUE  NONPRIORITY  BALKING  SEQUENTIAL  UNBOUNDED  MANAGED  NONITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 
package 

Queue_JJonprior i  ty_Balking_Sec[uent  ial_UnJDounde^Manage(iJJoni  terator  r s 


type  Queue  is  limited 

procedure  Copy 

procedure  Clear 
procedure  Add 

procedure  Pop 
procedure  Remove_Item 


private ; 

(FroirL_The_Queue  : 
To_The_Queue  : 
(The_Queue  : 
{The_Item  : 
To_'rhe_Queue  : 
{The_Queue  : 
{FroitL.The_Queue  : 
At_The_Position  : 


in  Queue; 
in  out  Queue) ; 
in  out  Queue) ; 
in  Item; 
in  out  Queue) ; 
in  out  Queue) ; 
in  out  Queue; 
in  Positive) ; 


Result  :  out  Natural); 


end  of  modification 


function  Is_Equal 

function  Length^Of 
function  Is_Einpty 
function  Front_Of 
fimction  Position_Of 


(Left 

in 

Queue ; 

Right 

in 

Queue) 

return 

Boolean; 

(The_Queue 

in 

Queue) 

return 

Natural; 

(The_Queue 

in 

Queue) 

return 

Boolean; 

(The_Queue 

in 

Queue) 

return 

Item; 

(The_Item 

in 

Item; 

In_The_Queue 

in 

Queue) 

return 

Natural ; 

Overflow 

Underflow 

Position_Error 


exception; 

exception; 

exception; 


procedure  Is_Equal 

procedure  Length^Of 
procedure  Is^Errpty 
procedure  Front_Of 
procedure  Position_Of 


(Left 

Right 

Result 

(The_Queue 

Result 

(The_Queue 

Result 

(The_Queue 

Result 

(The_Item 

In_The_Queue 


in  Queue; 
in  Queue; 
out  Boolean) ; 
in  Queue; 
out  Natural) ; 
in  Queue; 
out  Boolean) ; 
in  Queue; 
Item) ; 
in  I  tern; 
in  Queue; 


private 

type  Node; 

type  Structure  is  access  Node; 
type  Queue  is 
record 

The_Front  :  Structure; 

The_Back  :  Structure; 
end  record; 

end 

Queue_Nonpriority_Balking_Sequential_Unbounded_JIanaged^oniterator; 
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QUEUE  NONPRIORITY  BALKING  SEQUENTIAL  UNBOUNDED  MANAGED  NONITERATOR 

ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  siAject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Computer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

with  Storage_Manager_Sequential ; 
package  body 

Queue_Nonpr  ior  i  ty_Ba  lking_Sequen  t  ial_UnboundedJManaged_Noni  ter  a  t  or 

is 


type  Node  is 
record 

The_Item  :  Item; 

Next  :  Structure; 
end  record; 

procedure  Free  (The_Node  :  in  out  Node)  is 
begin 

null; 
end  Free; 

procedure  Set_Next  (The_JJode  ;  in  out  Node; 

To_Next  :  in  Structure)  is 

begin 

TheJSode.Next  :=  To^Mext; 
end  SetJIext; 

function  Next_Of  {The_Node  :  in  Node)  return  Structure  is 
begin 

return  The_^ode .  Next  ; 
end  Next_Of; 

package  NodeJManager  is  new  Storage_Manager_Sequential 

(Item  =>  Node, 

Pointer  =>  Structure, 

Free  =>  Free, 

Set^Pointer  =>  SetJJext, 
Pointer_Of  =>  Next_Of ) ; 

procedure  Copy  ( From_The_Queue  :  in  Queue; 

To_The_Queue  :  in  out  Queue)  is 
From_lndex  :  Structure  :=  FrotrL.The_Queue .  The_Front  ; 
To_Index  :  Structure; 
begin 

Node_Manager . Free ( To  jrhe_Queue . The_Fr on t ) ; 

To_The_Queue . The^Back  : =  null ; 
if  Fron\_The_Queue . The_Front  /=  null  then 

To_The_Queue , The_Front  :=  NodeJManager .New_Item; 

To jThe_Queue . The_Back  ;=  To_The_Queue . The^Front ; 
TOj.The_Queue .  The_Front .  The_I tern  :  =  From^Index .  The_Item; 
TOjIndex  :=  TOjThe_Queue .  The_Front  ; 

Fronuindex  :=  From_Index.Next; 
while  From_Index  /=  null  loop 

TOjIndex.Next  :=  NodeJManager .New_I tern; 

To_Index. Next. ThCj.! tern  :=  From_Index.The_Item; 
TOjIndex  :=  TOjIndex.Next; 

Fronuindex  :=  FronuIndex.Next; 

To_The_Queue . The_Back  ;=  To_Index; 
end  loop; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Copy; 

procedure  Clear  (The_Queue  :  in  out  Queue)  is 
begin 

NodeJManager . Free (The_Queue . The_Front ) ; 

The_Queue . The jBack  :=  null; 
end  Clear; 


procedure  Add  (Thejitem  :  in  I tern; 

TOjThejQueue  :  in  out  Queue)  is 

begin 

if  To j,The_Queue . The_Front  =  null  then 

TOjThejQueue .  The_Front  :  =  Node_Manager .  NeWj.Item; 
TOj,The_Queue .The_Front .The tern  :=  Thejitem; 
TOj.The_Queue.The_Back  :=  To_ThejQueue . The_Front ; 

else 

To_The_Queue . The_Back . Next  : =  NodeJManager . New^I tern ; 
To JThejQueue .  TheJBack .  Next .  The_I  tern ;  =  The_I  tern  ; 
ToZThe_Queue . The_Back  : =  To_The ^Queue . The_Back . Next ; 
end  if; 
exception 

when  Storage_Error  ss> 
raise  Overflow; 

end  Add; 


procedure  Pop  (The_Queue  :  in  out  Queue)  is 
Tenporary_Node  ;  Structure; 


begin 

Teinporary_Node  :=  The_Queue.The_Front; 

The^Queue .  The^Front  :  -  The^Queue .  ThCjFr ont .  Next  ; 
Tenporary_Node ,  Next  :  ==  nul  1  ; 

NodeJManager .  Free  (TeitporaryjNode )  ; 
if  ThejQueue.The_Front  =  null  then 
The_Queue . The_Back  : =  nu 1 1 ; 
end  if; 
exception 

when  ConstraintjError  => 
raise  Underflow; 

end  Pop; 

procedure  Removejitem  (FronuThCjOueue  :  in  out  Queue; 

Atj'IhejPosition  :  in  Positive)  is 

Count  :  Natural  :=  1; 

Previous  :  Structure; 

Index  ;  Structure  :=  FronVjThe_Queue .  The_Front  ; 

begin 

while  Index  /-  null  loop 

if  Count  =  At_The_Position  then 
exit; 

else 

Count  Count  +  1; 

Previous  Index; 

Index  ;=  Index. Next; 
end  if; 
end  loop; 

if  Index  =  null  then 

raise  Position_Error; 
elsif  Previous  =  null  then 

From_The_Queue . The_Front  ;=  Index. Next ; 

else 

Previous . Next  ; =  Index . Next ; 
end  if; 

if  FroouThejQueue .  TheJBack  «  Index  then 
FronL.The_Queue .  The_Back  :  =  Previous ; 
end  if; 

Index. Next  :=  null; 

NodeJManager , Free ( Index) ; 
end  Reinove_Item; 

modified  by  Tuan  Nguyen 
replacing  functions  with  procedures 

procedure  Is^Equal  (Left  : 

Right  : 

Result  : 

begin 

Result  :=  ISjEqual (Left, Right ) ; 
end  ISjEqual; 

procedure  LengthjOf  (ThejQueue  : 

Result  : 

begin 

Result  LengthjOf  (The_Queue)  ; 
end  LengthjOf; 

procedure  ISjEmpty  {The_Queue  ; 

Result  : 

begin 

Result  :=  ISjEnp ty( ThejQueue ) ; 
end  ISjErrpty; 

procedure  FrontjOf  (ThejQueue  : 

Result  : 

begin 

Result  :=  FrontjOf (ThejQueue) ; 
end  FrontjOf; 

procedure  PositioUjOf  (ThCjItem  : 

InjThejQueue  : 

Result  : 

begin 

Result  :=  Posit iottjOf (Thejitem, lUjThejQueue) ; 
end  PositiopjOf; 

end  of  modification 

function  ISjEqual  (Left  :  in  Queue; 

Right  :  in  Queue)  return  Boolean  is 
Leftjindex  :  Structure  :=  Left .The jFront; 

Right jindex  :  Structure  :=  Right . The_Front ; 
begin 

while  Leftjindex  /=  null  loop 

if  Leftjindex. ThCjItem  /=  Rightjindex. The jl tern  then 
return  False; 

else 

Le  f  tjindex  : =  Le f t jIndex , Nex t ; 

Rightjindex  :=  Righ t jindex. Next ; 
end  if; 
end  loop; 

return  (Rightjindex  =  null); 
exception 

when  ConstraintjError  => 
return  False; 
end  ISjEgual; 

function  LengthjOf  (The_Queue  :  in  Queue)  return  Natural  is 


in  Queue ; 
in  Queue; 
out  Boolean)  is 


in  Queue; 
out  Natural)  is 


in  Queue; 
out  Boolean)  is 


in  Queue; 
Item)  is 


in  I  tern; 
in  Queue; 
out  Natural )  is 
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Count  ;  Natural  :=  0; 

Index  :  Structure  The_Queue . The_Front ; 
begin 

while  Index  /=  null  loop 
Count  :=  Count  +  1; 

Index  :=  Index. Next; 
end  loop; 
return  Count; 
end  Length^Of; 

function  Is_Eti:pty  (The_Queue  ;  in  Queue)  return  Boolean  is 
begin 

return  {The_Queue.The_Front  =  null); 
end  Is_Entpty; 

fimction  Front^Of  (The_Queue  :  in  Queue)  return  Item  is 
begin 

re  turn  The_Queue - The_Fr ont . The_I t em ; 
exception 

when  Constraint_Error  => 
raise  Underflow; 


end  Front_0f; 

fvinction  Position_Of  (The^Item  :  in  Item; 

In_The_Queue  :  in  Queue)  return  Natural  is 
Position  :  Natural  :=  1; 

Index  :  Structure  :=  IrL_The_Queue . The_Front ; 
begin 

while  Index  /=  null  loop 

if  Index. The_I tern  s  The_Item  then 
return  Position; 

else 

Position  Position  +  1; 

Index  :=  Index. Next; 
end  if; 
end  loop; 
return  0; 
end  Position_0f; 

end 

Queue^onpriority_Balking_SequentialJJnbounded_ManagecLNoniterator; 
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QUEUE  NONPRIORITY  BALKING  SEQUENTIAL  BOUNDED  MANAGED  ITERATOR 

PSDL 


TYPE 

Queue  JJonpriori  ty__Ba  lking_Seqaent  i  al_UnboiindecfLManaged_Noni  t  era  t  or 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

FronuThe_Queue  ;  Queue, 

To_The_Queue  :  Queue 
OUTPUT 

To_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Queue  :  Queue 
OUTPUT 

The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Add 
SPECIFICATION 
INPUT 

The^Item  :  Item, 

To_The_Queue  :  Queue 
OUTPUT 

To_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Pop 
SPECIFICATION 
INPUT 

The_Qu€ue  :  Queue 
OUTPUT 

The^Queue  ;  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Remove_Item 
SPECIFICATION 
INPUT 

FronuThe^Queue  :  Queue , 

At_The_Position  ;  Positive 
OUTPUT 

From_The_Queue  ;  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position^Error 

END 


OPERATOR  Is_Equal 

SPECIFICATION 

INPUT 

Left  :  Queue, 

Right  :  Queue 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Length_Of 

SPECIFICATION 

INPUT 

The^Queue  :  Queue 
OUTPUT 

Result  2  Natural 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Is_Empty 

SPECIFICATION 

INPUT 

The_Queue  ;  Queue 
OUTPUT 

Result  :  Booleam 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Front_Of 

SPECIFICATION 

INPUT 

The^Queue  :  Queue 
OUTPUT 

Result  :  Item 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Position_Of 

SPECIFICATION 

INPUT 

The_Item  :  Item, 

In_The_Queue  :  Queue 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

END 

IMPLEMENTATION  ADA 

Queue_Nonpriority_Balking_Sequential_Unbounded_^anage<3LNoniterator 

END 
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QUEUE  NONPRIORITY  NONBALKING  SEQUENTIAL  BOUNDED  MANAGED  ITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 
package 

QueueJJonpriority_Nonbalking_Sequential_BoiindedJlanaged_Iterator  rs 

type  Queue (The_Size  :  Positive)  is  limited  private; 

procedure  Copy  { From_The_Queue  :  in  Queue; 

To_The_Queue  ;  in  out  Queue) ; 
procedure  Clear  (The_Queue  :  in  out  Queue) ; 

procedure  Add  {The_Item  :  in  Item; 

To_The_Queue  :  in  out  Queue) ; 
procedure  Pop  {The_Queue  :  in  out  Queue) ; 

--  modified  by  Tuan  Nguyen 
—  replacing  functions  with  procedures 

procedure  Is_Equal  (Left  :  in  Queue; 

Right  :  in  Queue; 

Result  :  out  Boolean) ; 

procedure  Length_Of  {The_Queue  :  in  Queue; 

Result  :  out  Natural) ; 

procedure  Is_Errpty  (The_Queue  :  in  Queue; 

Result  :  out  Boolean) ; 

procedure  Front_Of  (The_Queue  :  in  Queue; 

Result  :  Item) ; 


—  end  of  modification 

function  Is_Equal  (Left  :  in  Queue; 

Right  :  in  Queue)  return  Boolean; 

f\mction  Length_Of  (The_Queue  :  in  Queue)  return  Natural; 

function  Is„Enpty  (The_Queue  :  in  Queue)  return  Boolean; 

function  Front_Of  (The_Queue  ;  in  Queue)  return  Item; 

generic 

with  procedure  Process  (The^Item  :  in  I  tern; 

Continue  :  out  Boolean) ; 
procedure  Iterate  (Over_The_Queue  :  in  Queue) ; 

Overflow  :  exception; 

Underflow  :  exception; 

private 

type  Items  is  array  (Positive  range  <>)  of  Item; 
type  Queue (The_Si2e  :  Positive)  is 
record 

The_Back  :  Natural  :=  0; 

The^Items  :  Items (1  ..  The_Size) ; 
end  record; 

end  Queue^Nonpr ior i ty_Nonbalking_Sequent ial_Bounded_Managed„I terator 
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QUEUE  NONPRIORITY  NONBALKING  SEQUENTIAL  BOUNDED  MANAGED  ITERATOR 

ADA  IMPLEMENTATION 


(C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 
All  Rights  Reserved 

Serial  Number  0100219 

"Restricted  Rights  Legend" 

Use.  duplication,  or  disclosure  is  subject  to 
restrictions  as  set  forth  in  subdivision  (b)  (3)  (ii) 
of  the  rights  in  Technical  Data  and  Coitputer 
Software  Clause  of  FAR  52.227-7013.  Manufacturer: 
Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 
Colorado  80227  (1-303-987-1874) 


end  Is^Equal; 

procedure  Length_Of  (The_Queue  :  in  Queue; 

Result  :  out  Natural)  is 

begin 

Result  Length^Of (The_Queue) ; 
end  Length^Of; 

procedure  Is_Enpty  {The_Queue  ;  in  Queue; 

Result  :  out  Boolean)  is 

begin 

Resu It  : =  is^Empty ( The_Queue ) ; 
end  Is_Errpty; 


package  body 

Queue_Nonpriority_Nonbalking_Sec3uential_Boiinded^Jlanaged_Iterator 

is 


procedure  Copy  ( Froin_The_Queue  :  in  Queue  ; 

To_The_Queue  :  in  out  Queue)  is 

begin 

if  FroiiL_The_Queue.The_Back  >  To_The_Queue.The_Size  then 
raise  Overflow; 

elsif  FrottL,The_Queue  .The_Back  =  0  then 
To_The_Queue . The_Back  : =  0 ; 

else 

To_The_Queue .  The_I  terns  (1  . .  Fr ortL_The_Queue .  The_Back )  :  = 

Fr oiruThe^Queue .  The_I  terns  (1  . .  FrortL.The_Queue .  The_Back )  ; 
To_The_Queue .  The_Back  :  -  Fr onL.The_Queue .  The_Back  ; 
end  if; 
end  Copy; 

procedure  Clear  (The_Queue  :  in  out  Queue)  is 
begin 

The_Queue . The_Back  :=  0; 
end  Clear; 

procedure  Add  (The_Item  :  in  Item; 

To_The_Queue  :  in  out  Queue)  is 

begin 

To_The_Queue  .The_I terns  (To_The_Queue.The_Back  +1)  :=  The_Item; 

To_The_Queue .  The__Back  ;=  To_The_Queue .  The_Back  +  1; 
exception 

when  Const rain t_Err or  => 
raise  Overflow; 

end  Add; 

procedure  Pop  (The_Queue  ;  in  out  Queue)  is 
begin 

if  The_Queue . The_Back  =  0  then 
raise  Underflow; 

elsif  The_Queue . The_Back  =  1  then 
The_Queue . The_Back  :=  0; 

else 

The_Queue.The_Iteitis {1  ..  (The_Queue .The_Back  -1))  :  = 

The_Queue .  The_I terns  (2  .  .  The_Queue .  The_Back)  ,- 
The_Queue . The_Back  :=  The_Queue.The_Back  -  1; 
end  if; 
end  Pop; 

modified  by  Tuan  Nguyen 
replacing  functions  with  procedures 

procedure  Is_Equal  (Left 
Right 
Result 

begin 

Result  :=  Is_Equal (Left, Right) ; 


:  in  Queue; 

;  in  Queue; 

:  out  Boolean)  is 


procedure  Front_0f  (The_Queue  ;  in  Queue; 

Result  :  Item)  is 

begin 

Result  :=  Front_0f (The_Queue) ; 
end  Front_Of; 

end  of  modification 


function  Is_E<3ual  (Left  :  in  Queue; 

Right  :  in  Queue)  return  Boolean  is 

begin 

if  Left .The_Back  /=  Right -The^Back  then 
return  False; 

else 

for  Index  in  1  . .  Left.The_Back  loop 

if  Left  .The_Items  (Index)  /=  Right  .The_I terns  (Index) 


then 


return  False; 
end  if; 
end  loop; 
return  True; 
end  if; 
end  Is_Equal; 


function  Length„Of  (The_Queue  :  in  Queue)  return  Natural  is 
begin 

return  The_Queue . The_Back ; 
end  Length^Of; 

function  Is_Eiipty  (The_Queue  :  in  Queue)  return  Boolean  is 
begin 

return  (The_Queue-The_Back  =  0) ; 
end  Is_Eo?5ty; 


frinction  Front_Of  (The_Queue  :  in  Queue)  return  Item  is 
begin 

if  The_Queue . The_Back  =  0  then 
raise  Underflow; 

else 

return  The_Queue.The_Items(l)  ; 
end  if; 
end  Front_Of; 


procedure  Iterate  (Over_The_Queue  :  in  Queue)  is 
Continue  :  Boolean; 
begin 

for  The^Iterator  in  1  . .  Over_The^Queue . The^Back  loop 

Process (Over_The_Queue .The_I terns (The^Iterator ) ,  Continue) ; 
exit  when  not  Continue; 
end  loop; 
end  Iterate; 


end  Queue JJonpr iority_Nonbalking_Sequential^BoundedJlanaged^I  terator  ,- 
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QUEUE  NONPRIORITY  NONBALKING  SEQUENTIAL  BOUNDED  MANAGED  ITERATOR 


PSDL 


TYPE  Oueue_Nonpriority_JJonbalking_Sequential_Bounded_Managed_Iterator 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

FroiiL_The_Queue  :  Queue, 

To_The_Queue  :  Queue 
OUTPUT 

To_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Queue  :  Queue 
OUTPUT 

The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Add 
SPECIFICATION 
INPUT 

The^Item  :  Item, 

To_The_Queue  :  Queue 
OUTPUT 

To_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Pop 
SPECIFICATION 
INPUT 

The_Queue  :  Queue 
OUTPUT 

The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Is„Equal 
SPECIFICATION 
INPUT 

Left  :  Queue, 

Right  :  Queue 


OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Length^Of 

SPECIFICATION 

INPUT 

The_Queue  :  Queue 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Is^Enpty 

SPECIFICATION 

INPUT 

The_Queue  ;  Queue 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Front^Of 

SPECIFICATION 

INPUT 

The_Queue  ;  Queue 
OUTPUT 

Result  :  Item 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Iterate 

SPECIFICATION 

GENERIC 

Process  :  PROCEDURE [The.I tern  :  in[t  :  Item],  Continue  ;  outtt 

Boolean! ] 

INPUT 

Over_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

END 

IMPLEMENTATION  ADA 

QueueJNonpriorityJNonbalking_Seguential_Bounded-Managed_Iterator 

END 
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QUEUE  NONPRIORITY  NONBALKING  SEQUENTIAL  UNBOUNDED  MANAGED  NONITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 
package 

Queue_pJonpr  ior  i  ty_Nonbalking_S€quen  t  ial_Unbounded_Manageti_Noni  tera  t  or 
is 


type  Queue  is  limited  private; 

procedure  Copy  (Fron\_The_Queue  ;  in  Queue; 

To_The_Queue  :  in  out  Queue) ; 

procedure  Clear  (The_Queue  ;  in  out  Queue) ; 

procedure  Add  (The^Item  :  in  Item; 

To_The_Queue  :  in  out  Queue); 

procedure  Pop  (The_Queue  :  in  out  <^eue) ; 

modified  by  Tuan  Nguyen 
replacing  functions  with  procedures 

:  in  Queue ; 

:  in  Queue ; 

;  out  Boolean) ; 
:  in  Queue ; 

:  out  Natural) ; 
:  in  Queue ; 

:  out  Boolean) ; 


procedure  Is_Equal 


procedure  Length_Of 
procedure  Is_Enpty 


(Left 

Right 

Result 

(The_Queue 

Result 

(The^Queue 

Result 


procedure  Front_Of  (The_Queue 
Result 


end  of  modification 


in  Queue; 
Item)  ; 


function  Is^Ecjual  (Left 
Right 

f\mction  Length_Of  (The_Queue 
function  Is_Enpty  (The_Queue 
ftinction  Front_Of  (The_Queue 


in  Queue; 
in  Queue) 
in  Queue) 
in  Queue) 
in  Queue) 


return  Boolean; 
return  Natural; 
return  Boolean; 
return  Item; 


Overflow  :  exception; 
Underflow  :  exception; 


private 

type  Node; 

type  Structure  is  access  Node; 
type  Queue  is 
record 

The_Front  :  Structure; 

The_Back  :  Structure; 
end  record; 

end 

Queue^Nonpr  ior  i  ty J^onba  lking_Sequent  i  a  l_UnboundedL_ManagedLNoni  t  er  a  t  or 
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QUEUE  NONPRIORITY  NONBALKING  SEQUENTIAL  UNBOUNDED  MANAGED  NONITERATOR 

ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 


when  Storage_Error  »> 
raise  Overflow; 

end  Add; 


—  Serial  Number  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  {3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Conputer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

with  Storage_Manager_Sequential  ; 
package  body 

Queue_Nonpriority_Nonbalking_Sequential_UnboundedJ!anaged_Noniterator 

is 


type  Node  is 
record 

The_Item  ;  Item; 

Next  :  Structure; 
end  record; 

procedure  Free  (The_Node  :  in  out  Node)  is 
begin 

null; 
end  Free; 

procedure  Set_Next  {The_Node  :  in  out  Node; 

To_„Next  :  in  Structure)  is 

begin 

The Jfode .  Next  :  =  To_Next  ,- 
end  Set_Next; 

function  Next_Of  {The_Node  :  in  Node)  return  Structure  is 
begin 

return  The^Node . Next ; 
end  Next_0f; 

package  Node_llanager  is  new  Storage_Manager_Sequential 

(Item  =>  Node, 

Pointer  =>  Structure, 

Free  =>  Free, 

Set_Pointer  =>  Set_Next, 

Pointer_Of  Next_Of ) ; 


procedure  Pop  (The__Queue  :  in  out  Queue)  is 
TeiiporaryJNode  :  Structure; 
begin 

Temporary JNode  :  =  The^Queue .  The_Front ; 

The_Queue . The_Front  : =  The_Queue . The_Front • Next ; 
Temporary^Node .  Next  :  =  null  ; 

Node_Manager .  Free  (Ten^orary_Node) ; 
if  The_Queue , The_Front  =  null  then 
The_Queue.The_Back  ;=  null; 
end  if; 
exception 

when  Constraint^Error  => 
raise  Underflow; 

end  Pop; 

modified  by  Tuan  Nguyen 
replacing  functions  with  procedures 

procedure  Is_Equal  (Left 
Right 
Result 

begin 

Result  :=  Is^Equal (Left, Right) ; 
end  Is_Egual; 

procedure  Length_0f  (The_Queue 
Result 

begin 

Result  :=  Length_Of (The_Queue) ; 
end  Length_Of; 

procedure  Is_Enpty  (The_Queue 

Result 

begin 

Result  ;=  Is_Eir^ty  (The_Queue)  ; 
end  Is_EirT»ty; 

procedure  Front_Of  (The_Queue 

Result 

begin 

Result  :=  Front_Of (The_Queue) ; 
end  Front^Of; 

end  of  modification 


:  in  Queue; 

:  in  Queue; 

:  out  Boolean)  is 


:  in  Queue; 

:  out  Natural)  is 


:  in  Queue ; 

:  out  Boolean)  is 


:  in  Queue ; 
:  Item)  is 


procedure  Copy  (From_The_Queue  :  in  Queue; 

To_The_Queue  :  in  out  Queue)  is 
From_Index  :  Structure  :=  FroiiuThe_Queue.The_Front; 
To_Index  :  Structure; 
begin 

Node_Manager . Free ( To_The_Queue . The_Fr ont ) ; 

To_The_Queue .  The^Back  :  ==  null ; 
if  From_The_Queue.The_Front  /=  null  then 

To_The_Queue.The_Front  :=  NodeJIanager .New_Item; 
To_The_Queue . The_Back  :=  To_The_Queue,The_„Front; 
To_The_Queue .  The_Front .  The_I  tem  ;  =  From_Index .  The_I tern; 
To_Index  :=  To_The_Queue . The_Front ; 

From_Index  ;  =  From_Index .  Next ; 
while  Froin_Index  /=  null  loop 

To_Index .  Next  :  =  Node^Manager .  New_I  t  em  ; 

To__Index .  Next .  The_l  tem  :  =  From_ Index .  The_I  tem  ; 
To_Index  :=  To_Index.Next ; 

Froni_Index  :=  From^Index.Next; 

To_The_Queue .  The_Back  :=  To_Index; 
end  loop; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Copy; 

procedure  Clear  (The_Queue  :  in  out  Queue)  is 
begin 

Node_^anager .  Free  (The_Queue .  The__Front ) ; 

The__Queue .  The_Back  :  =  null  ; 
end  Clear ; 

procedure  Add  (The_Item  :  in  Item; 

To_The_Queue  :  in  out  Queue)  is 

begin 

if  To_The_Queue .  The_Front  =  null  then 

To_The_Queue .  The_Front  :=  Node_Manager.New_Item; 
To_The_Queue  .The_Front  .The_Item  ;=  The_Item; 
To_The_Queue . The_Back  ; =  To_The_Queue . The_Front ; 

else 

To_The_Queue.The_Back.Next  ;=  Node_Manager ,New_Item; 
To_The_Queue .  The_Back .  Next .  The_I  tem :  =  The_l  tem  ; 
To_The_Queue .  The_Back  :  =  To_The_Queue .  The_Bac  k .  Next  ; 
end  if; 
exception 


function  Is_Equal  (Left  :  in  Queue; 

Right  :  in  Queue)  return  Boolean  is 
Left_Index  :  Structure  :=  Left .The_Fr ont ; 

Right_Index  :  Structure  :=  Right . The_Front ; 
begin 

while  Left_Index  /=  null  loop 

if  Left_Index.The_Item  Right_Index.The_Item  then 
return  False; 

else 

Le  f  t_Index  : =  Le  f  t_Index . Nex t ; 

Right_Index  :=  Right_Index.Next ; 
end  if; 
end  loop; 

return  (Right_Index  =  null) ; 
exception 

when  Constraint_Error  => 
return  False ; 
end  Is_Equal; 

function  Length_Of  (The_Queue  :  in  Queue)  return  Natural  is 
Count  :  Natural  :=  0; 

Index  :  Structure  ;=  The_Queue . The_Front ; 
begin 

while  Index  /=  null  loop 
Count  :=  Count  +  1; 

Index  :=  Index. Next; 
end  loop; 
return  Count; 
end  Length_Of; 

function  Is_Eir?>ty  (The_Queue  ;  in  Queue)  return  Boolean  is 
begin 

return  (The_Queue.The_Front  =  null) ; 
end  Is_Eir5>ty; 

function  Front_Of  (The_Queue  :  in  Queue)  return  Item  is 
begin 

return  The_Queue .  The_Fr ont .  The_I  tem ; 
exception 

when  Cons t rain t_Err or  => 
raise  Underflow; 
end  Front_Of; 

end 

Queue_Nonpr  ior  i  ty JJonbalking_Seguen  t  i  al_UnboundedJManagedLNoni  t  er  at  or 
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QUEUE  NONPRIORITY  NONBALKING  SEQUENTIAL  UNBOUNDED  MANAGED  NONITERATOR 

PSDL 


TYPE 

Queue  JMonpr  ior  i  ty J^onbal  king_Sequen  t  i  a  l_Unbo'unded_Managed jJoni  tera  tor 
SPECIFICATION 

GENERIC 

Item  :  PRIVATE_TYPE 

OPERATOR  Copy 

SPECIFICATION 

INPUT 

Froii:L_The_Queue  :  Queue , 

To_The_Queue  :  Queue 
OUTPUT 

To_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Clear 

SPECIFICATION 

INPUT 

Th,e_Queue  :  Queue 
OUTPUT 

Th,e_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Add 

SPECIFICATION 

INPUT 

The_Item  :  Item, 

To_The_Queue  ;  Queue 
OUTPUT 

To_The_Queue  ;  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Pop 

SPECIFICATION 

INPUT 

The^Queue  :  Queue 
OUTPUT 

The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 


OPERATOR  Is.Equal 

SPECIFICATION 

INPUT 

Left  :  Queue, 

Right  :  Queue 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Length_Of 

SPECIFICATION 

INPUT 

The^Queue  :  Queue 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Is_Eir5>ty 

SPECIFICATION 

INPUT 

The_Queue  :  Queue 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Front_Of 

SPECIFICATION 

INPUT 

The_Queue  ;  Queue 
OUTPUT 

Result  :  Item 
EXCEPTIONS 

Overflow,  Underflow 

END 

END 

IMPLEMENTATION  ADA 

Queue^^Jonpr  i  or  i  tyJNonbalking_Sequen  t  xal_Unbounded_Managed_Noni  t  er  a  tor 
END 
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QUEUE  PRIORITY  BALKING  SEQUENTIAL  BOUNDED  MANAGED  ITERATOR 


ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

type  Priority  is  limited  private; 

with  function  Priori tY_Of  (The_Item  :  in  Item)  return 

Priority; 

with  function  "<="  {Left  ;  in  Priority; 

Right  :  in  Priority)  return  Boole^; 
package  Queue_Priority_Balking_Sequential_Bounded^ManagedLIterator  is 


type  Queue {The_Size  :  Positive)  is  limited  private; 


procedure  Copy 

procedure  Clear 
procedure  Add 

procedure  Pop 
procedure  Remove_Item 


( Fr onuThe^Queue 
To_The_Queue 
(The_Queue 
(The_Item 
To_The_Queue 
(The_Queue 
{ Fr om_The_Queue 
At_The_Position 


in  Queue ; 
in  out  Queue) ; 
in  out  Queue) ; 
in  Item; 
in  out  Queue ) ; 
in  out  Queue) ; 
in  out  Queue; 
in  Positive) ; 


—  modified  by  Tuan  Nguyen 

replacing  functions  with  procedures 


procedure  Position_Of 


(The_Item 

In_The_Queue 

Result 


in  Item; 
in  Queue; 
out  Natural) ; 


end  of  modification 


function  Is_Egual 


function  Length_Of 
function  Is_Enpty 
function  Front_Of 
function  Position_Of  {The_Item 

In_The„Queue 


(Left 

Right 

(The_Queue 

(The^Queue 

(The_Queue 


in  Queue; 
in  Queue) 
in  Queue) 
in  Queue) 
in  Queue) 
in  Item; 
in  Queue) 


return  Boolean 
return  Natural 
return  Boolean 
return  Item; 

return  Natural 


generic 

with  procedure  Process  (The_Item  :  in  I tern; 

Continue  :  out  Boolean) ; 
procedure  Iterate  (Over_The_Queue  ;  in  Queue) ; 


Overflow  :  exception; 
Underflow  ;  exception; 
Position_Error  :  exception; 


procedure  Is^Equal 


procedure  Length^Of 
procedure  Is^Errpty 
procedure  Front^Of 


(Left 

Right 

Result 

(The_Queue 

Result 

(The_Queue 

Result 

(The_Queue 

Result 


in  Queue; 
in  Queue; 
out  Boolean) ; 
in  Queue; 
out  Natural) ; 
in  Queue; 
out  Boolean) ; 
in  Queue; 
Item)  ; 


private 

type  Items  is  array  (Positive  range  <>}  of  Item; 
type  Queue (The_Size  :  Positive)  is 
record 

The_Back  :  Natural  :=  0; 

The_I terns  :  Items  (1  The_Size)  ; 
end  record; 

end  Queue_Priori ty_Balking_Sequent ial_Bounded^anaged_Iterator ; 
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QUEUE  PRIORITY  BALKING  SEQUENTIAL  BOUNDED  MANAGED  ITERATOR 

ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  s\ibdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Computer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body 

Queue_Priority_Balking_Sequential_Bo\inded_Mcinaged_Iterator  is 

procedure  Copy  (FronuThe^Queue  ;  in  Queue; 

To_The_Queue  :  in  out  Queue)  is 

begin 

if  FronuThe_Queue . The_Back  >  To_The_Queue.The_Size  then 
raise  Overflow; 

elsif  FroitL.The_Queue .  The_Back  =  0  then 
To_The_Queue.The_Back  ;=  0; 

else 

To_The_Queue .The^I terns (1  ..  FrotrL.The_Queue.The_Back}  :  = 
FrortL_The_,Queue .  The_l  terns  (1  . .  FronuThe_Queue .  The_Back ) ; 
To_The_Queue .  The_Back  :  =  Fr ottuThe^Queue .  The_Back  ; 
end  if; 
end  Copy; 

procedure  Clear  (The_Queue  ;  in  out  Queue)  is 
begin 

The_Queue .  The_Back  ;==  0; 
end  Clear; 

procedure  Add  (The_Item  :  in  Item; 

To_The_Queue  ;  in  out  Queue)  is 
Index  :  Natural  :=  1; 
begin 

if  To_The_Queue . The_Back  =  0  then 

To_The_Queue .  The_I  terns  ( To_The_Queue .  The_Bac  k  +  1 )  :  = 

The_Item; 

To_The_Queue.The_Back  :=  To_The_Queue . The_Back  +  1; 

else 

while  (Index  <=  To_The_Queue .The^Back)  and  then 
( Priority„Of ( The_I tern)  <= 

Priori ty_0f  (To_The_Queue  .The_Items  (Index) ) )  loop 
Index  :=  Index  +  1; 
end  loop; 

if  Index  >  To_The_Queue . The_Back  then 

To_The_Queue.  The_I  terns  (To_The_Queue.The_Back  +  1)  :  = 

The_Item; 

To_The_Queue .  The_Back  :=  To_The_Queue .  The_Back  +  1; 

else 

To_The_Queue .  The_I  terns 

((Index  +1)  ..  {To_The_Queue.The_Back  +1))  := 

To_The_Queue . The_I terns ( Index  . . 
To_The_Queue.The_Back) ; 

To_The_Queue .  The_I  terns  ( Index )  :  =  The_I  t  em  ,- 
To_The_Queue,The_Back  :=  To_The_Queue .The_Back  +  1; 
end  if; 
end  if; 
exception 

when  Constraint_Error  => 
raise  Overflow; 

end  Add; 

procedure  Pop  (The_Queue  :  in  out  Queue)  is 
begin 

if  The_Queue . The^Back  =  0  then 
raise  Underflow; 

elsif  The_Queue.The_Back  =  1  then 
The_Queue.The_Back  ;=  0; 

else 

The_Queue. The_I terns (1  ..  (The_Queue .The_Back  -  1) )  :  = 
The_Queue-The_Items  (2  The_Queue.The_Back) 

The_Queue . The_Back  :=  The_Queue . The^Back  -  1; 
end  if; 
end  Pop; 

procedure  Remove_ltem  { Fronv„The_Queue  :  in  out  Queue; 

At_The_Position  ;  in  Positive)  is 

begin 

if  Froir\_The_Queue .  The_Back  <  At_The_Position  then 
raise  Position_Error; 

elsif  Fr ont_The_Queue . The^Back  /=  At_The_Position  then 
From_The_Queue . The^Items 

(AtJThe^Position  ..  (From_The_Queue.The_Back  -1))  :  = 
From_The_Queue .The_I terns 

( (At_The_Position  +1)  ..  FroitL.The_Queue.The_Back) ; 

end  if; 

From_The_Queue .  The_Back  :=  FronuThe_Queue .  The_Back  -  1; 
end  Remove_Item; 


—  modified  by  Tuan  Nguyen 

—  replacing  fxmctions  with  procedures 

procedure  Is_E(3ual  (Left  :  in  Queue; 

Right  :  in  Queue; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is_Egual (Left, Right) ; 
end  Is_Egual; 

procedure  Length_Of  (The_Queue  :  in  Queue; 

Result  :  out  Natural)  is 

begin 

Resu 1 1  : =  Leng  th_0  f ( The_Queue ) ; 
end  Length_0f; 

procedure  Is_Enpty  (The^Queue  :  in  Queue; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is_Empty{The_Queue) ; 
end  Is_Enpty; 

procedure  Front_0f  (The_Queue  :  in  Queue; 

Result  :  Item)  is 

begin 

Result  :=  Front_0f (The_Queue) ; 
end  Front_Of; 

procedure  Position_Of  (The^Item  :  in  Item; 

In_The_Queue  :  in  Queue; 

Result  ;  out  Natural)  is 

begin 

Result  :=  Position_0f  {The_Item,  In_The_Queue)  ; 
end  Position_0f; 

—  end  of  modification 


function  Is_Equal  (Left  :  in  Queue; 

Right  :  in  Queue)  return  Boolean  is 

begin 

if  Left .The_Back  /=  Right .The_Back  then 
return  False; 

else 

for  Index  in  1  . .  Left .The_Back  loop 

if  Left  .The_I  terns  (Index)  /-  Right  .The_I  terns  (Index) 


return  False; 
end  if; 
end  loop; 
return  True; 
end  if; 
end  Is_Equal; 


fimction  Length_Of  (The_Queue  ;  in  Queue)  return  Natural  is 
begin 

return  The_Queue.The_Back; 
end  Length^Of; 


function  Is^Enpty  (The_Queue  ;  in  Queue)  return  Boolean  is 
begin 

return  ( The_Queue . Th€_Back  =  0 ) ; 
end  Is_Enipty; 


function  Front_0f  (The_Queue  :  in  Queue)  return  Item  is 
begin 

if  The_Queue . The_Back  «=  0  then 
raise  Underflow; 

else 

return  The^Queue . The_I terns ( 1 ) ; 
end  if; 


end  Front_Of; 


function  Position_Of  {The_Item  ;  in  Item; 

In_The_Queue  :  in  Queue)  return  Natural  is 

begin 

for  Index  in  1  . .  In_The_Queue .  The_Back  loop 

if  ln_The_Queue.The_I terns  (Index)  =  The_Item  then 
return  Index; 
end  if; 
end  loop; 
return  0; 
end  Position_Of; 


procedure  Iterate  (Over_The_Queue  ;  in  Queue)  is 
Continue  ;  Boolean; 
begin 

for  The_Iterator  in  1  . .  Over_The_Queue .  The_Back  loop 

Process  (Over_The_Queue . The^Items  (The_Iterator ) ,  Continue)  ; 
exit  when  not  Continue; 
end  loop; 
end  Iterate; 


end  Queue_Priority_Balking_Sequential_Bounded_ManagecLlterator  ; 
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QUEUE  PRIORITY  BALKING  SEQUENTIAL  BOUNDED  MANAGED  ITERATOR 


PSDL 


TYPE  Queue_Priority_Balking_Sequential_Bo\inded_MaiiagecLIterator 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TYPE, 

Priority  ;  PRIVATEJTYPE , 

Priority_Of  :  FUNCTION [The_I tern  :  Item,  RETURN  :  Priority], 
fuiic_"<="  :  FUNCTION[Left  :  Priority,  Right  :  Priority,  RETURN  : 
Boolean] 

OPERATOR  Copy 
SPECIFICATION 
INPUT 

Fron\_The_Queue  ;  Queue, 

To_The_Queue  :  Queue 
OUTPUT 

To_The_Queue  ;  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Posit ion_Error 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Queue  :  Queue 
OUTPUT 

The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Posit ion_Error 

END 

OPERATOR  Add 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

To_The_Queue  :  Queue 
OUTPUT 

To_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Pop 
SPECIFICATION 
INPUT 

The^Queue  :  Queue 
OUTPUT 

The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Remove_Item 
SPECIFICATION 
INPUT 

FronuThe_Queus  ■  Queue , 

At_The_Position  :  Positive 
OUTPUT 

Fron\_The_Queue  ;  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Is_Equal 
SPECIFICATION 
INPUT 


Left  :  Queue, 

Right  :  Queue 
OUTPUT 

Result  ;  Boolean 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

end 

OPERATOR  Length_Of 

SPECIFICATION 

INPUT 

The_Queue  :  Queue 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Is_Ernpty 

SPECIFICATION 

INPUT 

The_Queue  ;  Queue 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Front^Of 

SPECIFICATION 

INPUT 

The^Queue  ;  Queue, 

Result  :  Item 
EXCEPTIONS 

Overflow,  Underflow,  Position„Error 

END 

OPERATOR  Position^Of 

SPECIFICATION 

INPUT 

The_Item  :  Item, 

In^The_Queue  :  Queue 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Iterate 

SPECIFICATION 

GENERIC 

Process  :  PROCEDURE [The_Item  :  in[t  :  Item],  Continue 

Boolean] 3 
INPUT 

Over_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

END 

IMPLEMENTATION  ADA 

Queue_Priority_Balking_Sequential_Bounded_Jlanaged_Iterator 

END 


OUt[t  : 
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QUEUE  PRIORITY  BALKING  SEQUENTIAL  UNBOUNDED  MANAGED  NONITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

type  Priority  is  limited  private; 

with  function  Priori ty_Of  (The_Item  :  in  Item)  return 

Priority; 

with  function  "<="  {Left  :  in  Priority; 

Right  :  in  Priority)  return  Boolean; 

package 

Queue_Priority_Balking_Se<3uential_Unbounded_ManagedJ^oniterator  is 


type  Queue  is  limited  private; 


procedure  Copy 

procedure  Clear 
procedure  Add 

procedure  Pop 
procedure  Remove_Item 


( From_The_Queue 
To_'I1ie_Queue 
(The^Queue 
(The_Item 
To_The_Queue 
(The_Queue 
( From_The_Queue 
A t_The_Pos i t ion 


in 

Queue ; 

in 

out 

Queue) ; 

in 

out 

Queue) ; 

in 

I  tern; 

in 

out 

Queue) ; 

in 

out 

Queue) ; 

in 

out 

Queue; 

in 

Positive) 

Result 

procedure  Front_,Of  (The_Queue 
Result 

procedure  Position_Of  (The^Item 

In_The_Queue 

Result 


out  Boolean) ; 
in  Queue; 
Item) ; 
in  Item; 
in  Queue; 
out  Natural ) ; 


end  of  modification 


function  Is_Equal 

function  Length_Of 
function  Is_Ernpty 
function  Front_Of 
function  Posit ion_Of 


(Left 

in 

Queue; 

Right 

in 

Queue ) 

return 

Boolean; 

(The^Queue 

in 

Queue) 

return  Natural; 

( The_Queue 

in 

Queue) 

return 

Boolean; 

( The_Queue 

in 

Queue) 

return 

I  tern; 

(The_Item 

in 

Item; 

In_The__Queue 

in 

Queue) 

return 

Natural; 

Overflow 

Underflow 

Position_Error 


exception; 

exception; 

exception; 


—  modified  by  Tuan  Nguyen 

replacing  functions  with  procedures 


procedure  Is_E<3ual 

procedure  Length_Of 
procedure  Is_Enpty 


(Left 
Right 
Result 
( The_Queue 
Result 
(The_Queue 


in  Queue; 
in  Queue; 
out  Boolean) ; 
in  Queue; 
out  Natural) ; 
in  Queue; 


private 

type  Node; 

type  Structure  is  access  Node; 
type  Queue  is 
record 

The_Front  :  Structure; 

The_Back  :  S  t  rue  t ure ; 
end  record; 

end  Queue_Pr i or i ty_Balking_Sequen t i a l_UnboundedLManagedJHoni t era tor ; 
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QUEUE  PRIORITY  BALKING  SEQUENTIAL  UNBOUNDED  MANAGED  NONITERATOR 

ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 
--All  Rights  Reserved 

—  Serial  Number  0100219 

"Restricted  Rights  Legend" 

--  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Conputer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

with  Storage_Manager_Sequential ; 
package  bo^ 

Queue_Priority_Balking_Sequential_Unbounded_Managed_Noniterator  is 

type  Node  is 
record 

The^Item  :  Item; 

Next  :  Structure; 

end  record; 

procedure  Free  (The_Node  :  in  out  Node)  is 
begin 

null; 
end  Free; 

procedure  Set_Next  (The_Node  :  in  out  Node; 

To_Next  :  in  Structure)  is 

begin 

The_Node.Next  :=  ToJNext; 
end  Set^ext; 

function  Next_Of  (The_Node  ;  in  Node)  return  Structure  is 
begin 

return  The^ode.Next; 
end  Next_Of; 

package  Node_J!anager  is  new  Storage_Manager_Sequential 

(Item  =>  Node, 

Pointer  =>  Structure, 

Free  =>  Free, 

Set_Pointer  =>  Set_Next, 
Pointer_Of  =>  Next_Of ) ; 

procedure  Copy  ( Fr om_The_Queue  :  in  Queue; 

To_The_Queue  :  in  out  Queue)  is 
From_Index  :  Structure  :=  FronuThe^Queue .  The_Front ; 
To_lndex  :  Structure ; 
begin 

Node JManager .  Free  { To_The_Queue ,  The_Fr ont ) ; 

To_The_Queue . The_Back  :=  null; 
if  From_The_Queue . The_Front  null  then 

To_The_Queue .  The_Front  :=  Node  JManager  .New_I  tern; 
To__The_Queue .  The^Back  :  =  To_The_Queue .  The_Front  ; 
To_The_Queue .  The_Fr on t .  The_l  tern  :  =  Pr onuindex .  The_l  tern ; 
To_Index  :=  To_The_Queue . The_Fr ont ; 

Fr om^lndex  : =  Fr om_Index . Next ; 
while  From_Index  /=  null  loop 

To_Index.Next  :=  Node_Manager.New_Item; 
To_Index.Next -The_Item  :=  FronuIndex.The_Item; 
To_Index  :=  To_Index.Next; 

Fronjindex  :=  From_lndex.Next; 

To_The_Queue .  77ie_Back  :  =  To_Index ; 
end  loop; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Copy; 


To_The_Queue . The_Front . Next  ;=  Index; 
if  To_The_Queue . The_Back  =  null  then 

To_The_Queue .  Ihe_Back  : =  To_The_Queue . The_Fr ont ; 
end  if; 

elsif  Index  =  null  then 

To_The_Queue , The_Bac k . Next  : =  Node_Manager . New_I tern ; 
To_The_Queue . The_Back  : =  To_The_Queue . The„Back . Next ; 
To_The_Queue.The_Back.The_Item  :=  The^Item; 

else 

Previous. Next  :=  Node_Manager.New_Itein; 

Previous.Next .The_Item  :=  The_Item; 

Previous .Next .Next  :=  Index; 
end  if; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 

end  Add; 

procedure  Pop  (The_Queue  ;  in  out  Queue)  is 
Tentporary_Node  ;  Structure; 
begin 

Temporary_Node  : »  The_Queue .  The_Front ; 

The_Queue . The_Fr ont  : =  The_Queue . The_Front . Next ; 

Tempor ary^Node . Next  z-  null; 

Node^Manager ,Free(Tenporary_Node) ; 
if  The_Queue,The_Front  =  null  then 
The_Queue . The_Back  :=  null; 
end  if; 
exception 

when  Constraint_Error  => 
raise  Underflow; 

end  Pop; 

procedure  Remove_Item  ( Froin_The_Queue  :  in  out  Queue; 

At_The_Position  :  in  Positive)  is 
Count  :  Natural  :=  1; 

Previous  :  Structure; 

Index  :  Structure  ;=  From_The_Queue . The_Fr ont ; 
begin 

while  Index  /=  null  loop 

if  Count  =  At_The_Position  then 
exit; 

else 

Count  :=  Count  +  1; 

Previous  :=  Index; 

Index  :=  Index. Next; 
end  if; 
end  loop; 

if  Index  =  null  then 

raise  Position_Error ; 
elsif  Previous  =  null  then 

Fr om_The_Queue . The_Fr ont  : =  Index . Next ; 

else 

Previous . Next  : =  Index . Next ; 
end  if; 

if  Froit\_'Ihe_Queue . The_Back  =  Index  then 
From_The_Queue . The_Back  :=  Previous; 
end  if; 

Index . Next  : =  null ; 

Node_Manager . Free ( Index) ; 
end  Remove_Item; 

modified  by  Tuan  Nguyen 
replacing  fxinctions  with  procedures 

procedure  Is„Equal  (Left  ;  in  Queue; 

Right  ;  in  Queue; 

Result  :  out  Boolean)  is 

begin 

Result  : =  Is_Equal ( Lef t , Right ) ; 
end  Is_Equal; 


procedure  Clear  ('Ihe_Queue  :  in  out  Queue)  is 
begin 

Node_Manager . Free (The_Queue . The_Front ) ; 
The_Queue . Th€_Bac k  : =  nu 1 1 ; 
end  Clear; 


procedure  Length^Of  (The_Queue  :  in  Queue; 

Result  :  out  Natural)  is 

begin 

Result  :=  Length_Of (The_Queue) ; 
end  Length_0f; 


procedure  Add  (The_Item  :  in  I  tern; 

To_The_Queue  :  in  out  Queue)  is 
Previous  :  Structure ; 

Index  :  Structure  :=  To_The_Queue.The_Front; 
begin 

if  To_The_Queue . The_Front  =  null  then 

To^The_Queue .  The_Front  :=  Node_Manager  .New_Item; 
To_The_Queue.The_Front.The_Item  :=  The__Item; 
To_The_Queue . The_Back  : =  To_The_Queue . The_Front ; 

else 

while  (Index  /=  null)  and  then 
(Priori ty_0 f ( The_l tern )  < = 

Priority_Of( Index, The_I tern) )  loop 
Previous  : =  Index ; 

Index  Index, Next; 
end  loop; 

if  Previous  =  null  then 

To__The__Queue .  The_Fr ont  :  =  Node_Manager .  Newi,!  tem ; 
To_The__Queue  -  The_Front .  The_Item  :  =  The_I  tern ; 


procedure  Is_Eitpty  (The_Queue 

Result 

begin 

Result  :=  Is_Empty(The_Queue) ; 
end  Is_En5)ty; 

procedure  Front_Of  (The_Queue 

Result 

begin 

Result  :=  Front^Of (The_Queue) ; 
end  Front_Of; 


in  Queue ; 
out  Boolecin)  is 


in  Queue; 
Item)  is 


procedure  Position_Of 


{The_Item 

In_The_Queue 

Result 


in  Item; 
in  Queue; 
out  Natural) 


begin 

Result  : =  Po s i t ion_Of ( The_I t em , In_The_Queue ) ; 
end  Position_Of; 


is 
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end  of  modification 

function  Is^Equal  (Left  :  in  Queue; 

Right  :  in  Queue)  return  Boolean  is 
Left^Index  :  Structure  :=  Lef t .The^Front ; 

Right_Index  :  Structure  Right . The_Front ; 

begin 

while  Left_Index  /=  null  loop 

if  Left_lndex-The_ltem  /=  Right_Index.The_Item  then 
return  False; 

else 

Left_Index  :=  Left_Index.Next; 

Right_Index  :=  Right^Index.Next ; 
end  if; 
end  loop; 

return  (Right_Index  =  null); 
exception 

when  Cons t rain t_Err or  => 
return  False; 
end  Is_Equal; 

fxinction  Length_Of  (The_Queue  :  in  Queue)  return  Natural  is 
Count  :  Natural  :=  0; 

Index  :  Structure  :=  The_Queue . The_Front ; 
begin 

while  Index  /=  null  loop 
Count  Count  +  1; 

Index  :=  Index. Next; 
end  loop; 
return  Count; 
end  Length^Of; 


fxinction  Is_Eni>ty  {The_Queue  ;  in  Queue)  return  Boolean  is 
begin 

return  {The_Queue.The_Front  =  null); 
end  Is_En?>ty; 

function  Front_Of  (The_Queue  ;  in  Queue)  return  Item  is 
begin 

return  The_Queue .  The_Front .  The_I tern  ; 
exception 

when  Constraint_Error  => 
raise  Underflow; 
end  Front_Of; 

function  Position_Of  (The_Item  :  in  Item; 

In^The_Queue  :  in  Queue)  return  Natural  is 
Position  :  Natural  :=  1; 

Index  :  Structure  In_The_Queue . The_Front ; 
begin 

while  Index  /=  null  loop 

if  Index. The„I tern  =  The_Item  then 
return  Position; 

else 

Position  :=  Position  +  1; 

Index  ;=  Index. Next; 
end  if; 
end  loop; 
return  0; 
end  Position_0f; 

end  Queue_Pr  ior  i  ty_Balking_Sequential_UnboundedLJlanagedJMoni  terator ; 
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QUEUE  PRIORITY  BALKING  SEQUENTIAL  UNBOUNDED  MANAGED  NONITERATOR 

PSDL 


TYPE  Queue^Pr iori  ty_Balking_Sequential_Unbounded_Managed_Noni  t  erator 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TYPE, 

Priority  :  PRIVATE_TYPE , 

Priority_Of  :  FUNCTION [The_I tern  :  Item,  RETURN  ;  Priority] , 
func_“<="  :  FUNCTION[Left  :  Priority,  Right  :  Priority,  RETURN  ; 
Boolean] 

OPERATOR  Copy 
SPECIFICATION 
INPUT 

Froii\_The_Queue  :  Queue , 

To_The_Queue  :  Queue 
OUTPUT 

To_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Queue  :  Queue 
OUTPUT 

The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Add 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

To_The_Queue  :  Queue 
OUTPUT 

To_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Pop 
SPECIFICATION 
INPUT 

The_Queue  :  Queue 
OUTPUT 

The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Remove_Item 
SPECIFICATION 
INPUT 

From_The_Queue  :  Queue , 

At_The_Position  :  Positive 
OUTPUT 

Prom_The_Queue  ;  Queue 
EXCEPTIONS 


Overflow,  Underflow,  Position^Error 

END 

OPERATOR  Is_Equal 

SPECIFICATION 

INPUT 

Left  :  Queue, 

Right  :  Queue 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Length_Of 

SPECIFICATION 

INPUT 

The^Queue  :  Queue 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Is_Enpty 

SPECIFICATION 

INPUT 

The_Queue  :  Queue 
OUTPUT 

Result  :  Booleaui 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Front^Of 

SPECIFICATION 

INPUT 

The_Queue  :  Queue , 

Result  :  Item 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Position^Of 

SPECIFICATION 

INPUT 

The^ltem  :  Item, 

In_The_Queue  ;  Queue 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

END 

IMPLEMENTATION  ADA 

Queue_Priority__Balking_Seq:uential_Unbounded_JlanagedJNoniterator 

END 
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QUEUE  PRIORITY  NONBALKING  SEQUENTIAL  BOUNDED  MANAGED  ITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

type  Priority  is  limited  private; 

with  fxinction  Priority_Of  {The_Item  :  in  Item)  return 
Priority; 

with  function  "<="  (Left  :  in  Priority; 

Right  :  in  Priority)  return  Boolean; 
package  Queue_Priority_Nonbalking_Sequential_Bo\indecLJlanagecLIterator 
is 


type  Queue (The_Size  ;  Positive)  is  limited  private; 


Result 

:  out  Boolean) 

procedure  Front_0f 

(The^Queue 

:  in  Queue ; 

end  of  modification 

Result 

:  Item) ; 

£;mction  Is^Egual  (Left 
Right 

function  Length_Of  (The^Queue 
function  Is_E[npty  (The_Queue 
function  Front_Of  {The_Queue 


in  Queue; 
in  Queue) 
in  Queue) 
in  Queue) 
in  Queue) 


return  Boolean; 
return  Natural; 
return  Boolean; 
ret\im  Item; 


procedure  Copy  ( From_The_Queue  :  in  Queue; 

To_The_Queue  :  in  out  Queue) ; 
procedure  Clear  (The^Queue  :  in  out  Queue) ; 

procedure  Add  (The_Item  :  in  Item; 

To_The_Queue  :  in  out  Queue) ; 
procedure  Pop  (The_Queue  :  in  out  Queue) ; 

—  modified  by  Tuan  Nguyen 

—  replacing  functions  with  procedures 


procedure  Is_Equal 


procedure  Length_Of 
procedure  Is_Enpty 


(Left 

Right 

Result 

(The_Queue 

Result 

(The_Queue 


in  Queue; 
in  Queue; 
out  Boolean) ; 
in  Queue; 
out  Natural) ; 
in  Queue; 


generic 

with  procedure  Process  (The_Item  :  in  Item; 

Continue  :  out  Boolean) ; 
procedure  Iterate  (Over_The_Queue  :  in  Queue) ; 

Overflow  :  exception; 

Underflow  ;  exception; 

private 

type  Items  is  array (Positive  range  <>)  of  Item; 
type  Queue (The^Size  :  Positive)  is 
record 

The_Back  :  Natural  ;=  0; 

The_ltems  :  Items (1  ..  The_Size) ; 
end  record; 

end  Queue_Priori tyJNonbalking_Seguent ial_Bounded_ManagedLIterator ; 
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QUEUE  PRIORITY  NONBALKING  SEQUENTIAL  BOUNDED  MANAGED  ITERATOR 

ADA  IMPLEMENTATION 


—  (C>  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Nximber  0100219 

-Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  {3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Computer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  {1-303-987-1874) 

package  body 

Queue_Priority_JJonbalking_Sequential_BoundedJIanagedLIterator  is 

procedure  Copy  (Froii\_The_Queue  :  in  Queue; 

To_The_Queue  ;  in  out  Queue)  is 

begin 

if  FrorcL.The_Queue .  The_Back  >  To_The_Queue .  The^Size  then 
raise  Overflow; 

elsif  FroitL.The_Queue .  The_Back  =  0  then 
To_The_Queue . The_Back  :=  0; 

else 

To_The_Queue . The_I terns (1  . .  Fr onuThe_Queue . The_Back )  : = 
Fr ortuThe_Queue .  The_I  terns  (1  . .  Fr om_The_Queue .  The_B  ack )  ; 
To_The_Queue .  The_Back  :  =  FronuThe_Queue .  The_Back  ; 
end  if; 
end  Copy; 

procedure  Clear  (The_Queue  :  in  out  Queue)  is 
begin 

The__Queue .  The_B  ack  :  =  0 ; 
end  Clear; 

procedure  Add  (The^Item  :  in  Item; 

To_The_Queue  :  in  out  Queue)  is 
Index  :  Natural  1; 
begin 

if  To^The_Queue . The_Back  =  0  then 

To_The_Queue .  The_I  terns  ( To_The_Queue .  The^Back  +  1 )  :  = 

The_Item; 

To_The_Queue.The_Back  :=  To_The_Queue . The_Back  +  1; 

else 

while  (Index  <=  To_The_Queue.The_Back)  and  then 
( Prior i ty_Of (The_Item)  <= 

Pr ior i ty_Of { To_The_Queue . The_I terns { Index ) ) )  loop 
Index  :=  Index  +  1; 
end  loop; 

if  Index  >  To_The_Queue . The_Back  then 

To_The_Queue.  The_I  terns  {To_The_Queue-The_Back  +1)  :  = 

The_Item; 

To_The_Queue . The_Back  ;=  To_The_Queue . The_Back  +  1; 

else 

To_The_Queue . The_I terns 

((Index  +1)  ..  (To_The_Queue.The_Back  +1))  := 

To_The_Queue . The_I terns ( Index  . . 

To_The_Queue .  The_Back)  ; 

To_The_Queue .  The_I  terns  { Index )  ;  =  The_I  tern  ; 
To_The_Queue.The_Back  :=  To_The_Queue . The_Back  +  1; 
end  if; 
end  if; 
exception 

when  Constraint_Error  => 
raise  Overflow; 

end  Add; 

procedure  Pop  (The_Queue  :  in  out  Queue)  is 
begin 

if  The_Queue . The_Back  =  0  then 
raise  Underflow; 

elsif  The__Queue . The_Back  =  1  then 
The_Queue . The_Back  0; 

else 

The_Queue.The_Items(l  ..  (The_Queue.The_Back  -  D)  :  = 
The_Queue .  The_I  terns  (2  .  .  The_Queue .  The_Back )  ; 
The_Queue.The_Back  :=  The_Queue . The__Back  -  1; 
end  if; 


end  Pop; 


modified  by  Tuan  Nguyen 
replacing  functions  with  procedures 


procedure  Is_Equal  (Left 
Right 
Result 

begin 

Result  :=  Is_Equal (Left, Right) ; 
end  Is_Equal; 


in  Queue; 
in  Queue; 
out  Boolean)  is 


procedure  Length_Of  (The_Queue  :  in  Queue; 

Result  :  out  Natural)  is 

begin 

Result  Length_Of (The_Queue) ; 
end  Length^Of; 

procedure  Is^Empty  {The_Queue  :  in  Queue; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is„En5pty(The_Queue)  ; 
end  Is_Errpty; 


procedure  Front_Of  (The_Queue  :  in  Queue; 

Result  :  Item)  is 

begin 

Result  :=  Front_Of (The^Queue) ; 
end  Front_Of; 


end  of  modification 


function  Is^Equal  (Left  :  in  Queue; 

Right  :  in  Queue)  return  Boolean  is 

begin 

if  Left.The_Back  /=  Right . The_Back  then 
return  False; 

else 

for  Index  in  1  . .  Left .The_Back  loop 

if  Left.The_Items( Index)  /=  Right .The_I terns (Index) 


end  if; 
end  loop; 
return  True; 
end  if; 
end  Is^Equal; 

function  Length_Of  (The_Queue  :  in  Queue)  return  Natural  is 
begin 

re  turn  The_Queue . The_Back ; 
end  Length_Of; 

fijnction  Is_Empty  (The_Queue  ;  in  Queue)  return  Boolean  is 
begin 

return  (The_Queue.The_Back  =  0) ; 
end  Is_En^ty; 


function  Front_Of  (The_Queue  ;  in  Queue)  return  Item  is 
begin 

if  The_Queue . The_Back  =  0  then 
raise  Underflow; 

else 

return  The^Queue .  The_I terns  ( 1 )  ; 
end  if; 
end  Front_Of; 


procedure  Iterate  (Over_The_Queue  ;  in  Queue)  is 
Continue  :  Boolean; 
begin 

for  The^Iterator  in  1  . .  Over_The_Queue . The^Back  loop 

Pr oce ss ( Over_The_Queue . The_I terns ( The_I t era tor ) ,  Continue 
exit  when  not  Continue; 
end  loop; 
end  Iterate; 


end  Queue_Priority_Nonbalking_Sequential_Bounded_Managed_Iterator ; 
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QUEUE  PRIORITY  NONBALKING  SEQUENTIAL  BOUNDED  MANAGED  ITERATOR 

PSDL 


TYPE  Queue_Priority_JMonbalking_Sequential_BoundedJManaged_lterator 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TYPE, 

Priority  :  PRIVATE_TYPE , 

Priori ty_Of  :  FUNCTION [The_I tern  :  Item,  RETURN  :  Priority], 
func_*'<=“  ;  FUNCTION[Left  :  Priority,  Right  :  Priority,  RETURN  : 
Boolean] 

OPERATOR  Copy 
SPECIFICATION 
INPUT 

FronuThe_Queue  :  Queue, 

To_The_Queue  :  Queue 
OUTPUT 

To_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Queue  :  Queue 
OUTPUT 

The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Add 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

To_The_Queue  :  Queue 
OUTPUT 

To_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Pop 
SPECIFICATION 
INPUT 

The_Queue  :  Queue 
OUTPUT 

The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Is_Equal 
SPECIFICATION 
INPUT 


Left  :  Queue, 

Right  :  Queue 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Length_Of 

SPECIFICATION 

INPUT 

The_Queue  :  Queue 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Is  Eir5>ty 

SPECIFICATION 

INPUT 

The^Queue  ;  Queue 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Front_Of 

SPECIFICATION 

INPUT 

The_Queue  ;  Queue, 

Result  :  Item 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Iterate 

SPECIFICATION 

GENERIC 

Process  :  PROCEDURE [The_I tern  :  in[t  :  Item],  Continue  :  out(t 
Booleain]  ] 

INPUT 

Over_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

END 

IMPLEMENTATION  ADA 

Queue_Pr  i  or  i  tyJNonba  Iking^Sequen  t  ial__BoundedLManaged_I  ter  a  t  or 
END 
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QUEUE  PRIORITY  NONBALKING  SEQUENTIAL  UNBOUNDED  MANAGED  NONITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

type  Priority  is  limited  private; 

with  function  Priority_Of  {The_Item  :  in  Item)  return 

Priority; 

with  function  “<=-  (Left  :  in  Priority; 

Right  :  in  Priority)  return  Boolean; 

package 

Queue^Priori ty_Nonbalking_Sequential_Unbounded_JIanaged_Noni tera tor  xs 
type  Queue  is  limited  private; 


Result 

procedure  Front_Of  ( The_Queue 
Result 


end  of  modification 


out  Boolean) ; 
in  Queue; 
Item)  ; 


function  Is_Equal  (Left 
Right 

function  Length_Of  (The_Queue 
function  Is_Err5>ty  (The_Queue 
f\inction  Front_Of  {The_Queue 


in  Queue; 
in  Queue) 
in  Queue) 
in  Queue) 
in  Queue) 


return  Boolean; 
return  Natural; 
return  Boolean; 
return  I tern; 


procedure  Copy 

procedure  Clear 
procedure  Add 

procedure  Pop 


( FroirL_The_Queue 
To„The_Queue 
{The_Queue 
(The_Item 
To_The_Queue 
(The_Queue 


in  Queue ; 

in  out  Queue) ; 
in  out  Queue) ; 
in  I  tern; 

in  out  Queue) ; 
in  out  Queue) ; 


modified  by  Tuan  Nguyen 
replacing  functions  with  procedures 


procedure  Is_Equal  (Left 

Right 
Result 

procedure  Length_Of  (The_Queue 
Result 

procedure  Is_Eit5)ty  (The_Queue 


in  Queue; 
in  Queue; 
out  Boolean) ; 
in  Queue; 
out  Natural) ; 
in  Queue; 


Overflow  :  exception; 

Underflow  ;  exception; 

private 

type  Node; 

type  Structure  is  access  Node; 
type  Queue  is 
record 

The^Front  :  Structure; 

The_Back  :  Structured- 
end  record; 

end 

Queue_Priority^onbalking_Sequential_Unbounded_Managed__Noniterator 
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QUEUE  PRIORITY  NONBALKING  SEQUENTIAL  UNBOUNDED  MANAGED  NONITERATOR 

ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Computer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

with  Storage_Manager_Sequential; 
package  body 

Queue_Pr  ior  i  ty_Nonbalking_Sequen  t  i  a  l_Unbounded_Managed_Noni  t  er  a  t  or 
is 

type  Node  is 
record 

The_Itein  :  I  tern; 

Next  :  Structure; 

end  record; 

procedure  Free  (ThejNode  :  in  out  Node)  is 
begin 

null ; 
end  Free; 

procedure  Set^Next  (ThejNode  :  in  out  Node; 

To_Next  :  in  Structure)  is 

begin 

The_Node .  Next  :  =  To JJext ; 
end  Set_Next; 

function  Next^Of  (The_Node  :  in  Node)  return  Structure  is 
begin 

return  The_Node.Next ; 
end  Next_Of; 

package  Node_Manager  is  new  StorageJJanager_Sequential 

(Item  =>  Node, 

Pointer  =>  Structure, 

Free  =>  Free, 

Set_Pointer  =>  Set_Next, 
Pointer_Of  =>  Next_Of ) ; 

procedure  Copy  ( FronuThe^Queue  :  in  Queue; 

To^The^Queue  :  in  out  Queue)  is 
Fronjlndex  :  Structure  :=  From_The_Queue . The^Front ; 
To_Index  ;  Structure; 
begin 

Node_llanager .  Free  ( To_The_Queue .  The_Fr ont ) ; 

To_The_Queue . The_Back  : =  null ; 
if  From_The_Queue . The_Front  /=  null  then 

To_The_Queue .  The_Fr on t  ;  =  NodeJMtenager ,  New_I  tern  ; 
To_The_Queue .  The_Back  :  =  To__The_Queue .  The_Front ; 
To_The_Queue . The_Fr on t . The_I t em  : =  From^Index . The_I t em  ; 
To^Index  :=  To_The_Queue.The_Front; 

Prom_Index  :=  From_Index,Next; 
while  From_Index  /=  null  loop 

To_Index .  Next  :  =  Node_^anager .  New_I  tern  ; 

To^Index .  Next .  The_I  t em  :  =  Fron\_Index .  The_I  tern ; 
To^Index  :=  To_Index . Next ; 

From_Index  :=  From_Index.Next; 

To_The_Queue . The_Back  To_Index; 

end  loop; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Copy; 

procedure  Clear  (The_Queue  ;  in  out  Queue)  is 
begin 

Node Jlanager .  Free  { The_Queue .  The_Front ) ; 

'Kae_Queue.The„Back  :=  null; 
end  Clear; 

procedure  Add  (The_Item  :  in  I  tern; 

To_The_Queue  :  in  out  Queue)  is 
Previous  :  Structure; 

Index  :  Structure  :=  To_The_Queue .  The_Front ; 
begin 

if  To_The_Queue . The_Front  =  null  then 

To_The_Queue . The_Fr on t  : =  Node_Manager . New_I tern ; 
To_The_Queue . The_Front . The_Item  : =  The_Item; 
To_The_Queue .  The_Back  :  =  To__The_Queue .  The_Front  ; 

else 

while  (Index  /=  null)  and  then 
{Priority_Of {The_Item)  <= 

Prior ity_Of ( Index .The_I tern) )  loop 
Previous  :=  Index; 

Index  ;=  Index. Next ; 
end  loop; 

if  Previous  =  null  then 

To_'I1ie_Queue .  The_Front  :  =  Node_Manager  .New_Item; 


To_The„Queue. The_Fr ont .The_I tern  :=  The^Item; 
To_The_Queue .  The_Fr ont .  Next  :  s:  index  ; 
if  To_The_Queue . The_Back  =  null  then 

To_The_Queue . The_Back  r  =  To jrhe_Queue . The_Fr ont ; 
end  if; 

els if  Index  =  null  then 

To__The_Queue.The_Back.Next  Node_Manager.New_Item; 
To_The_Queue . The_Bac k  : =  To_The_Queue . The_Back . Next ; 
To_The_Queue.The_Back.The_Item  :=  The_Item; 

else 

Previous . Next  :  =  NodeJManager . New_I tern; 

Previous.Next .The_Item  :*=  The_Item; 

Previous .Next .Next  :=  Index; 
end  if; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 

end  Add; 

procedure  Pop  (The_Queue  :  in  out  Queue)  is 
Temporary  JNode  ;  Structure; 
begin 

Tenporary__Node  :=  The_Queue .  The_Front ; 

The_Queue.The_Front  :=  The_Queue. The_Fr ont .Next ; 
Tert^porary_Node.Next  ;=  null; 

Node__Manager .  Free  ( Teinporary__Node )  ; 
if  The_Queue . The_Front  =  null  then 
The_Queue . The_Back  : =  null ; 
end  if; 
exception 

when  Constraint_Error  => 
raise  Underflow; 

end  Pop; 

—  modified  by  Tuan  Nguyen 

—  replacing  functions  with  procedures 

procedure  Is_E<iual  (Left  :  in  Queue; 

Right  :  in  Queue; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is_Equal (Left, Right) ; 
end  Is_Equal; 

procedure  Length_Of  {The_Queue  :  in  Queue ; 

Result  :  out  Natural)  is 

begin 

Result  Length_Of (The_Queue) ; 

end  Length_Of; 

procedure  Is_Empty  (The_Queue  :  in  Queue ; 

Result  :  out  Boolean)  is 

begin 

Result  Is_Empty(The_Queue) ; 

end  Is_Empty; 

procedure  Front_Of  (The_Queue  :  in  Queue; 

Result  :  Item)  is 

begin 

Result  :=  Front_Of (The_Queue) ; 
end  Front_0f; 

end  of  modification 

function  Is_Equal  (Left  :  in  Queue; 

Right  ;  in  Queue)  return  Boolean  is 
Left_Index  :  Structure  ;=  Left .The_Front ; 

Right_Index  ;  Structure  :=  Right . The_Front ; 
l3egin 

while  Left_Index  /=  null  loop 

if  Left_Index.The_Item  /=  Right_Index.The_Item  then 
return  False; 

else 

Left_Index  :=  Left_Index.Next ; 

Right_Index  :=  Right_Index.Next ; 
end  if; 
end  loop; 

return  ( Right _Index  =  null) ; 
exception 

when  Constraint_Error  => 
return  False; 
end  ls_Egual; 

function  Length_0f  (The_Queue  ;  in  Queue)  return  Natural  is 
Count  :  Natural  :=  0; 

Index  ;  Structure  :=  ThejQueue . The_Front ; 
begin 

while  Index  /=  null  loop 
Count  :=  Coxint  +  1; 

Index  :=  Index. Next; 
end  loop; 
return  Coxint; 
end  Length_Of; 

function  Is_Enipty  (The_Queue  :  in  Queue)  return  Boolean  is 
begin 

return  (The_Queue .The_Front  =  null); 
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end  Is_Eii?5ty; 


function  Front_Of  (The_Queue  ;  in  Queue)  return  Item  is 
begin 

return  The_Queue - The_Fr ont . The_I tern ; 
exception 


when  Constraint_Error  => 
raise  Underflow; 
end  Front_Of; 


end 

Queue_Pr  ior  i  ty_Nonbalking_Sequen  t  ial_UnboundedUManaged_Noni  t  era  tor 
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QUEUE  PRIORITY NONBALHNG  SEQUENTIAL  UNBOUNDED  MANAGED  NONITERATOR 

PSDL 


TYPE 

Queue_Pr  ior  i  ty^onba  lking_Se<3uent  i  a  l_Unboundec5LfIanaged_Noni  t  er  a  t  or 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE^TYPE, 

Priority  :  PRIVATE_TYPE, 

Priority_Of  :  FUNCTION [The_Item  ;  Item,  RETURN  :  Priority! , 
func_"<=“  :  FUNCTIONlLeft  :  Priority,  Right  :  Priority,  RETURN  ; 
Boolean] 

OPERATOR  Copy 
SPECIFICATION 
INPUT 

Fro]H_The_Queue  :  Queue, 

To_The_Queue  ;  Queue 
OUTPUT 

To_The__Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Queue  :  Queue 
OUTPUT 

The^Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Add 
SPECIFICATION 
INPUT 

The^Item  :  Item, 

To_The_Queue  :  Queue 
OUTPUT 

To_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Pop 
SPECIFICATION 
INPUT 

The^Queue  :  Queue 
OUTPtJT 

The_Queue  :  Queue 
EXCEPTIONS 


Overflow,  Underflow 

END 

OPERATOR  Is„Equal 

SPECIFICATION 

INPUT 

Left  :  Queue, 

Right  :  Queue 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Length_Of 

SPECIFICATION 

iNPtrr 

The_Queue  :  Queue 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Is^Empty 

SPECIFICATION 

INPUT 

The_Queue  :  Queue 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Front.Of 

SPECIFICATION 

INPUT 

The_Queue  :  Queue, 

Result  :  Item 
EXCEPTIONS 

Overflow,  Underflow 

END 

END 

IMPLEMENTATION  ADA 

Queue_PriorityJNonbalking_Sequential_UnboundedLManage<3LNoniterator 

END 
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QUEUE  NONPRIORITY  BALKING  SEQUENTIAL  UNBOUNDED  UNMANAGED  ITERATOR 


ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 
package 

Queue_Nonpr ior i ty_Balking_Sequential_tJnboiinded_Uninanaged_I tera tor  is 


type  Queue  is  limited  private; 


procedure  Copy 

procedure  Clear 
procedure  Add 


{ From^The^Queue 
To_The_Queue 
(The_Queue 
(The_Item 
To^The^Queue 
(The_Queue 
( From_The_Queue 
At_The_Position 


in  Queue; 
in  out  Queue) ; 
in  out  Queue) ; 
in  Item; 
in  out  Queue) ; 
in  out  Queue) ; 
in  out  Queue; 
in  Positive) 


procedure  Pop 
procedure  Remove_Item 


—  modified  tiy  Tuan  Nguyen 


replacing 

functions 

with  procedures 

procedure 

Is_E<iual 

(Left 

Right 

Result 

in  Queue; 
in  Queue; 
out  Boolean) ; 

procedure 

Length_Of 

{The_Queue 

Result 

in  Queue; 
out  Natural) ; 

procedure 

Is_Empty 

(The_Queue 

Result 

in  Queue; 
out  Boolean) ; 

procedure 

Front^Of 

(The^Queue 

Result 

in  Queue; 
Item) ; 

procedure 

Position_Of  (The_Item 

In_The_Queue 

in  I tern; 
in  Queue; 

Result  :  out  Natural) ; 


end  of  modification 


function  Is_Equal 

function  Length_Of 
function  Is_Eirpty 
function  FrontjOf 
function  Position_Of 


(Left 
Right 
(The_.Queue 
{The_Queue 
{ The_Queue 
(The_Item 
In_The_Queue 


in  Queue; 
in  Queue) 
in  Queue) 
in  Queue) 
in  Queue) 
in  Item; 
in  Queue) 


return  Boolean; 
return  Natural; 
return  Boolean; 
return  Item; 

return  Natural; 


generic 

with  procedure  Process  (The_Item  :  in  Item; 

Continue  :  out  Boolean) ; 
procedure  Iterate  (Over_The_Queue  :  in  Queue) ; 


Overflow  ;  exception; 
Underflow  ;  exception; 
Position^Error  ;  exception; 


private 

type  Node; 

type  Structure  is  access  Node; 
type  Queue  is 
record 

The_Front  :  Structure; 

The_Back  ;  Structure; 
end  record; 

end  Queue_Nonpriority_Balking_Sequential_UnboundedLUnmanaged_I terator ; 
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QUEUE  NONPRIORITY  BALKING  SEQUENTIAL  UNBOUNDED  UNMANAGED  ITERATOR 

ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Niimber  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  stibdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  CoiT?)uter 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  {1-303-987-1874} 

package  body 

Queue_Nonpr  iori  ty_Balking_Sequent  ial_Unbounded_Unmcuiaged_I  terator 
is 


type  Node  is 
record 

The_Item  :  Item; 

Next  :  Structure; 

end  record; 


procedure  Copy  {Froin_The_Queue  :  in  Queue; 

To_The_Queue  :  in  out  Queue)  is 
From_Index  :  Structure  :=  Frorn_The_Queue .  The_Front ; 
To_Index  :  Structure; 
begin 

if  FronL_The_Queue.The_Front  =  null  then 
To_The_Queue . The_Front  :=  null; 

To_The_Queue . The_Back  :=  null; 

else 


To_The_Queue .  The^Front  :  = 

new  Node'  (The_Item  =>  Frorrulndex.The_Item, 
Next  =>  null ) ; 

To_The_Queue . The_Back  ; =  To_The_Queue . The_Front ; 
To_Index  :=  To_The_Queue . The_Fr ont ; 

Frortuindex  ;=  Frort^Index.Next; 
while  Fron\_Index  /=  null  loop 

To_Index . Next  :=  new  Node ' {The_I tern  => 
From_Index .  The_Item, 


Next  =>  null) ; 


To_Index  :=  To_Index.Next ; 
Fronuindex  :=  Froin^Index.Next ; 
To_The_Queue . The_Back  : =  To_Index ; 
end  loop; 
end  if; 
exception 

when  Storage^Error  => 
raise  Overflow; 
end  Copy; 


Previous  :=  Index; 

Index  :=  Index. Next; 
end  if; 
end  loop; 

if  Index  =  null  then 

raise  Position_Error; 
elsif  Previous  =  null  then 

From_The_Queue . The_Front  ; =  Index . Next ; 

else 

Previous . Next  ; =  Index . Next ; 
end  if; 

if  Fron\_The„Queue . The_Back  =  Index  then 
Fr om_The_Queue . The_Back  : =  Previous ; 
end  if; 

end  Remove^Item; 

modified  by  Tuan  Nguyen 
replacing  f-unctions  with  procedures 

procedure  Is^Egual  (Left  : 

Right  : 

Result  : 

begin 

Result  :=  Is_Equal (Left, Right) ; 
end  Is_Equal; 

procedure  Length_Of  (The^Queue  : 

Result  ; 

begin 

Result  ;=  Length_Of (The_Queue) ; 
end  Length_Of; 

procedure  Is_Empty  (The_Queue  : 

Result  : 

begin 

Result  :=  Is_En55ty  (The_(Jueue)  ; 
end  Is_Empty; 

procedure  Front_Of  (The_Queue  : 

Result  : 

begin 

Result  :»  Pront_0f (The_Queue) ; 
end  Front_0f; 

procedure  Position„0f  (The_Item  ; 

In„The_Queue  : 

Result  : 

begin 

Result  :=  Position_Of {The_Item, In_The_Queue) ; 
end  Position_Of ; 

end  of  modification 


in  Queue; 
in  Queue; 
out  Boolean)  is 


in  Queue; 

out  Natural)  is 


in  Queue; 

out  Boolean)  is 


in  Queue; 
Item)  is 


in  I  tern; 
in  Queue; 
out  Natural)  is 


procedure  Clear  (The_Queue  :  in  out  Queue)  is 
begin 

The_Queue  :=  Queue  * (The_Front  =>  null, 
The_Back  =>  null) ; 

end  Clear; 


procedure  Add  (The^Item  :  in  Item; 

To_The_Queue  ;  in  out  Queue)  is 

begin 

if  To_The_Queue . The^Front  =  null  then 

To_The_Queue . The_Front  ;=  new  Node'  (The^Item  =>  The^Item, 

Next  =>  null) ; 

To_The_Queue . The_Back  :=  To_The_Queue . The_Front ; 

else 


To_The_Queue .Th€_Back.Next  :=  new  Node ' (The„I tern  => 


The_Item, 


To_The_Queue . The_Back 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 


Next  =>  null) ; 
To_The_Queue .  The^Back .  Next ; 


end  Add; 


procedure  Pop  (The_Queue  :  in  out  Queue)  is 
begin 

The_Queue . The_Fr ont  : =  The_Queue . The_Front . Next ; 
if  The_Queue.The_Front  =  null  then 
The_Queue.The_Back  :=  null; 
end  if; 
exception 

when  Constraint^Error  => 
raise  Underflow; 

end  Pop; 


function  Is_Equal  (Left  ;  in  Queue; 

Right  :  in  Queue)  return  Boolean  is 
Left_Index  :  Structure  :=  Left .The_Front; 

Right_Index  :  Structure  :=  Right .The_Front; 
begin 

while  Left^Index  /=  null  loop 

if  Left_Index.The_Item  /=  Right_Index.The_Item  then 
return  False; 

else 

Left_Index  Left_Index.Next; 

Right_Index  : s  Right^Index . Next ; 
end  if; 
end  loop; 

return  (Right_Index  =  null) ; 
exception 

when  Constraint_Error  => 
return  False; 
end  Is„Equal; 

function  Length^Of  (The_Queue  :  in  Queue)  return  Natural  is 
Count  :  Natural  :=  0; 

Index  :  Structure  ;=  The_Queue . The_Fr ont ; 
begin 

while  Index  /=  null  loop 
Count  ;=  Count  +  1; 

Index  ;=  Index. Next; 
end  loop; 
return  Count; 
end  Length^Of; 

function  Is_Enpty  {The_Queue  :  in  Queue)  return  Boolean  is 
begin 

return  ( The_Queue . The_Fr on t  =  nu 1 1 ) ; 
end  Is_En?)ty; 


procedure  Remove_Item  ( Fr om_The_(5ueue  :  in  out  Queue; 

At_The_Position  :  in  Positive)  is 
Count  :  Natural  :=  1; 

Previous  :  Structure ; 

Index  :  Structure  :=  Fronu.The_Queue.The_Front; 

begin 

while  Index  /=  null  loop 

if  Colon t  =  At_The_Position  then 
exit; 

else 

Coiont  ;=  Count  +  1; 


function  Front„Of  (The^Queue  :  in  Queue)  return  Item  is 
begin 

re  turn  The_Queue . The_Fr ont . The_I t em ; 
exception 

when  Constraint_Error  => 
raise  Underflow; 
end  Front_Of; 

function  Position^Of  (The_Item  ;  in  Item; 

In^The_Queue  :  in  Queue)  return  Natural  is 
Position  :  Natural  ;=  1; 
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Index  :  Structure  :=  In_The_Queue , The_Front ; 
begin 

while  Index  /-  null  loop 

if  Index. The_I tern  =  The_ltem  then 
return  Position; 

else 

Position  :=  Position  +  1; 

Index  :=  Index. Next; 
end  if; 
end  loop; 
return  0; 
end  Position_Of; 


procedure  Iterate  (Over_The_Queue  :  in  Queue)  is 

The_Iterator  :  Structure  :=  Over_The_Queue . The_Front ; 

Continue  :  Boolean; 

begin 

while  not  (The_Iterator  =  null)  loop 

Process (The_I terator . The_Item,  Continue ) ; 
exit  when  not  Continue; 

The_Iterator  :=  The_I terator .Next ; 
end  loop; 
end  Iterate; 

end  Queue_Nonpr  i  or i  ty_Balking_Sequen t  ial_UnboundedLUninanagedLI  t er a t  or ; 
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QUEUE  NONPRIORITY  BALKING  SEQUENTIAL  UNBOUNDED  UNMANAGED  ITERATOR 

PSDL 


TYPE  Queue_Nonpriority_Balking_Sequential_Unbo'unded_Uninanaged^Iterator 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE^TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

Froiti_The_Queue  :  Queue, 

To_The_Queue  :  Queue 
OUTPUT 

To_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position^Error 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Queue  ;  Queue 
OUTPUT 

The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Add 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

To_The_Queue  :  Queue 
OUTPUT 

To_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Pop 
SPECIFICATION 
INPUT 

The^Queue  :  Queue 
OUTPUT 

The^Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Remove_Item 
SPECIFICATION 
INPUT 

FronuThe^Queue  :  Queue , 

At_The_Position  ;  Positive 
OUTPUT 

Froiru.The_Queue  ;  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Is_Egual 
SPECIFICATION 
INPUT 

Left  :  Queue, 

Right  ;  Queue 


OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Length^Of 

SPECIFICATION 

INPUT 

The_Queue  :  Queue 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Is_Etnpty 

SPECIFICATION 

INPUT 

The^Queue  :  Queue 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Front^Of 

SPECIFICATION 

INPUT 

The_Queue  :  Queue, 

Result  :  Item 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Position_Of 

SPECIFICATION 

INPUT 

The_Item  :  Item, 

In_The_Queue  :  Queue 

ouTPirr 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow,  Position__Error 

END 

OPERATOR  Iterate 

SPECIFICATION 

GENERIC 

Process  :  PROCEDURE [The_I tern  :  in[t  :  Item],  Continue  ;  out[t 
Boolean] ] 

INPUT 

Over_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

END 

IMPLEMENTATION  ADA 

Queue JNonpriori  ty_Balking_Se(3uen  t  ial_Unbounded_Unmanaged_I  t  era  tor 
END 
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QUEUE  NONPRIORITY  NONBALKING  SEQUENTIAL  UNBOUNDED  UNMANAGED  ITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 
package 

Queue_Nonpr ior i ty_Nonbalk ing_Sequen t ia l_Unbounded_Unmanaged_I ter a t or 
is 


type  Queue  is  limited  private; 


procedure  Copy  ( From_The__Queue  :  in  Queue; 

To_The_Queue  :  in  out  Queue) ; 
procedure  Clear  (The_Queue  :  in  out  Queue) ; 

procedure  Add  (The^ltem  :  in  Item; 

To_The_Queue  :  in  out  Queue) ; 
procedure  Pop  (The_Queue  :  in  out  Queue) ; 

modified  by  Tuan  Nguyen 
replacing  ftmctions  with  procedures 


procedure  Is_Equal 


procedure 

procedure 

procedure 


Length_Of 

Is_Empty 

Front^Of 


(Left 

Right 

Result 

{The_Queue 

Result 

(The_Queue 

Result 

(The^Queue 

Result 


in  Queue; 
in  Queue; 
out  Boolean) ; 
in  Queue; 
out  Natural); 
in  Queue; 
out  Boolean) ; 
in  Queue; 
Item)  ; 


end  of  modification 


fiinction  Is_Equal  (Left 
Right 

fimction  Length_Of  (The_Queue 
function  Is_Errpty  {The_Queue 
function  Front_Of  (The^Queue 


in  Queue; 
in  Queue) 
in  Queue) 
in  Queue) 
in  Queue) 


return  Boolean; 
return  Natural; 
return  Boolean; 
return  I tern; 


generic 

with  procedure  Process  (The^Item  :  in  Item; 

Continue  :  out  Boolean) ; 
procedure  Iterate  { Over_The_Queue  :  in  Queue) ; 


Overflow  :  exception; 
Underflow  :  exception; 


private 

type  Node; 

type  Structure  is  access  Node; 
type  Queue  is 
record 

The_Front  :  Structure; 

The^Back  ;  Structure; 
end  record; 

end 

Queue_Nonpr  ior  i  ty_Nonba  lking_Seciuent  i  al_Unbounded_Unmanaged_I  t  era  tor 
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QUEUE  NONPRIORITY  NONBALKING  SEQUENTIAL  UNBOUNDED  UNMANAGED  ITERATOR 

ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

--  "Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  {b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Computer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body 

Queue_Nonpr  ior  i  ty_Nonbalking_Seguent  ial_Unbounded_UnmanagecLI  t  er  at  or 
is 


type  Node  is 
record 

The_Item  :  Item; 

Next  :  Structure; 
end  record; 

procedure  Copy  {From_The_Queue  :  in  Queue; 

To_The_Queue  :  in  out  Queue)  is 
Fronuindex  :  Structure  :=  FroitL_The_Queue .  The_Front  ; 
To_Index  :  Structure ; 
begin 

if  FrorrL_The_Queue.The_Front  =  null  then 
To_'The_Queue . The^Front  :=  null; 

To„The_Queue . The_Back  : =  nul 1 ; 

else 

To_The_Queue . The^Fr ont  : = 

new  Node’ {The_Item  =>  From_Index.The_rtem, 

Next  =>  null ) ; 

To_The_Queue.The_Back  :=  To_The_Queue . The_Front ; 
To_Index  : =  To_The_Queue . The_Fr ont ; 

From_Index  :=  From_Index.Next; 
while  From_Index  /=  null  loop 

To_Index.Next  :=  new  Node'  (The_Item  => 
Fronuindex ,  The_I  tern. 

Next  =>  null); 

To^Index  :=  To_Index .  Next ; 

Fronuindex  :=  Frortuindex  .Next  ; 

To_The_Queue .  The_Back  :=  To^Index; 
end  loop; 
end  if; 
exception 

when  Storage^Error  => 
raise  Overflow; 
end  Copy; 


procedure  Clear  {The_Queue  :  in  out  Queue)  is 
begin 

The_Queue  :=  Queue  * (The^Front  =>  null, 
The_Back  =>  null) ; 

end  Clear ; 


procedure  Add  (The_Item  :  in  Item; 

To_The_Queue  ;  in  out  Queue)  is 

begin 

if  To_The_Queue . The^Front  =  null  then 

To_The_Queue .  The_Front  ;=  new  Node  ’  {The_I tern  =>  The_Item, 

Next  =>  null); 

To_The_Queue .  The_Back  :  =  To_The_Queue .  The„Front ; 

else 

To_The_Queue . The_Back . Next  new  Node'  (The_Item  => 


The_Item, 


Next  =>  null) ; 


To_The_Queue .  The^Back  :  =  To_The^Queue .  The_Back .  Next ; 
end  if; 


exception 

when  Storage_Error  => 
raise  Overflow; 


end  Add; 


procedure  Pop  (The_Queue  :  in  out  Queue)  is 
begin 

The^Queue .  The_Fr ont  :  =  The_Queue .  The_Front .  Next ; 
if  The_Queue - The_Front  =  null  then 
The__Queue . The_Back  :=  null; 
end  if; 
exception 

when  Constraint_Error  => 
raise  Underflow; 

end  Pop; 


—  modified  by  Tuan  Nguyen 

—  replacing  f\mctions  with  procedures 

procedure  Is_Equal  (Left  :  in  Queue; 

Right  :  in  Queue; 

Result  ;  out  Boolean)  is 

begin 

Result  ; =  Is_Equal (Lef t , Right) ; 
end  Is_Equal; 

procedure  Length_0f  (The_Queue  ;  in  Queue; 

Result  :  out  Natural)  is 

begin 

Result  :=  Length_Of (The^Queue) ; 
end  Length_0f; 

procedure  Is_Enpty  (The_Queue  :  in  Queue; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is_En?Jty  {The_Queue)  ; 
end  Is_Empty; 

procedure  Front_0f  (The_Queue  :  in  Queue; 

Result  :  Item)  is 

begin 

Result  :=  Front_Of (The_Queue) ; 
end  Front_0f; 

—  end  of  modification 

function  Is_Equal  (Left  :  in  Queue; 

Right  :  in  Queue)  return  Boolean  is 
Left_Index  :  Structure  :=  Left .The_Fr ont ; 

Right_Index  ;  Structure  :=  Right . The_Front ; 
begin 

while  Left_Index  /=  null  loop 

if  Lef t_Index,The_I tern  /-  Right_Index.The_Item  then 
return  False; 

else 

Left_Index  Lef t_Index. Next; 

Right_Index  :=  Right_Index.Next; 
end  if; 
end  loop; 

return  {Right_Index  =  null); 
exception 

when  Constraint_Error  => 
return  False; 
end  Is_Equal; 

function  Length_Of  (The_Queue  :  in  Queue)  return  Natural  is 
Count  :  Natural  :=  0; 

Index  :  Structure  ;=  The_Queue . The^Fr ont ; 
begin 

while  Index  /=  null  loop 
Count  2=  Count  +  1; 

Index  :=  Index. Next; 
end  loop; 
return  Count; 
end  Length_Of; 

function  Is_Enpty  (The^Queue  ;  in  Queue)  return  Boolean  is 
begin 

return  { The_Queue . The^Front  =  null) ; 
end  Is_,Einpty; 

function  Front_Of  (The_Queue  :  in  Queue)  return  Item  is 
begin 

return  The^Queue . The_Fr ont . The_I t em ; 
exception 

when  Constraint^Error  => 
raise  Underflow; 
end  Front__Of; 

procedure  Iterate  (Over_'Ihe_Queue  ;  in  Queue)  is 

The_Iterator  :  Structure  :=  Over_The_Queue.The_Front; 
Continue  :  Boolean ; 

begin 

while  not  (The_Iterator  =  null)  loop 

Process (The_Iterator . The_Item,  Continue ) ; 
exit  when  not  Continue; 

The^Iterator  : =  The_I terator . Next ; 
end  loop; 
end  Iterate; 

end 

Queue  JNfonpr  ior  ity JNonbalking^Sequen  t  ial_Unbounded^Unmanaged_I  terator 
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QVEVE  NONPRIORITY  NONBALKING  SEQUENTIAL  UNBOUNDED  UNMANAGED  ITERATOR 


PSDL 


TYPE 

Queue_Nonpr  ior  i  ty_Nonbalkiiig_Sequent  i  al_Unbounde<i_Unmanaged_I  t  er  a  1 0  r 

SPECIFICATION 

GENERIC 

Item  :  PRIVATE_TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

Frortv_The_Queue  :  Queue, 

To_The_Queue  :  Queue 
OUTPUT 

To_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Queue  :  Queue 
OUTPUT 

The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Add 
SPECIFICATION 
INPUT 

Th€_Item  :  Item, 

To_The_Queue  :  Queue 
OUTPUT 

To_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Pop 
SPECIFICATION 
INPUT 

The_Queue  :  Queue 
OUTPUT 

The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Is_Equal 
SPECIFICATION 
INPUT 

Left  ;  Queue, 


Right  ;  Queue 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Length_Of 

SPECIFICATION 

INPUT 

The_Queue  :  Queue 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Is^Enpty 

SPECIFICATION 

INPUT 

The_Queue  :  Queue 
OUTPUT 

Result  :  Boolecin 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Front_Of 

SPECIFICATION 

INPUT 

The_Queue  :  Queue, 

Result  :  Item 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Iterate 

SPECIFICATION 

GENERIC 

Process  :  PROCEDURE [The_I tern  :  in ft  :  Item],  Continue  :  out[t 

Boolean] ] 

INPUT 

Over_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

END 

IMPLEMENTATION  ADA 

Queue_Nonpriority_Nonbalking_Seguential__Unbounded_UninanagecLIterator 

END 


152 


QUEUE  PRIORITY  BALKING  SEQUENTIAL  UNBOUNDED  UNMANAGED  ITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

type  Priority  is  limited  private; 

with  function  Priority^Of  (The_Item  ;  in  Item)  return 
Priority; 

with  function  “<="  {Left  :  in  Priority; 

Right  :  in  Priority)  return  Boolean; 
package  Queue_Priority_Balking_Sequential_UnboundedLUninanaged_Iterator 
is 


function  Is_Einpty 
function  Front_Of 
function  Position_Of 


(The^Queue 

(The_Queue 

(The_Item 

In_The_Queue 


in  Queue) 
in  Queue) 
in  I  tern; 
in  Queue) 


return  Boolean; 
return  Item; 

return  Natural; 


generic 

with  procedure  Process  (The^Item  :  in  I tern; 

Continue  :  out  Boolean) ; 
procedure  Iterate  (Over_The_Queue  ;  in  Queue) ; 


type  Queue  is  limited  private; 


procedure  Copy 

procedure  Clear 
procedure  Add 

procedure  Pop 
procedure  Reroove^Item 


( Fr om_The_Queue 
To_The_Queue 
{The_Queue 
(The^Item 
To_The_Queue 
(The_Queue 
( Fr onuThe_Queue 
A t_The_Pos i t ion 


in  Queue ; 
in  out  Queue) ; 
in  out  Queue) ; 
in  Item; 
in  out  Queue) ; 
in  out  Queue) ; 
in  out  Queue; 
in  Positive) ; 


function  Is_Egual  (Left 
Right 

fimction  Length_Of  (The_Queue 


in  Queue; 

in  Queue)  return  Boolean; 
in  Queue)  return  Natural; 


Overflow  :  exception; 

Underflow  :  exception; 

Position_Error  ;  exception; 

private 

type  Node; 

type  Structure  is  access  Node; 
type  Queue  is 
record 

The_Front  :  Structure; 

The_Back  :  Structure; 
end  record; 

end  Queue_Priori ty_Balking_Seguential_Unbounded_Unmcinaged_Iterator ; 
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QUEUE  PRIORITY  BALKING  SEQUENTIAL  UNBOUNDED  UNMANAGED  ITERATOR 

ADA  IMPLEMENTATION 


--  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Nuniber  0100219 

•Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  sxibject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Computer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 


package  boc^ 

Queue_Priority_3alking_Sequential_UnboundecLUnitianaged_lterator  is 

type  Node  is 
record 

The_Item  :  I  tern; 

Next  :  Structure; 

end  record; 


procedure  Copy  ( From_The_Queue  :  in  Queue; 

To_The_Queue  :  in  out  Queue)  is 
Fronulndex  :  Structure  :=  Froin_The_Queue.The_Front; 
To_Index  :  Structure; 
begin 

if  From_The_Queue . The^Front  =  null  then 
To_The_Queue . The_Front  :=  null; 

To„The_Queue . The_Back  : =  null; 

else 


To_The_Queue .  The_Front  :  = 

new  Node '  {The_I tern  =>  FroituIridex.The_Item, 

Next  =>  null) ; 

To_The_Queue .  The_Back  ;=  To_The_Queue .  The_Front ; 
To_Index  : =  To_The_Queue , The_Front ; 

From^Index  :=  Frorn_Index.Next ; 
while  Frorn_Index  /=  null  loop 

To_Index.Next  :=  new  Node'  (The_Item  => 
Froin_Index .  The_Itein, 

Next  =>  null); 


To__Index  :=  To_Index.Next ; 
Fronulndex  Frorn_Index .  Next ; 
To_The_Queue . The_Back  ;=  To_Index; 
end  loop; 
end  if; 
exception 

when  Storage^Error  => 
raise  Overflow; 
end  Copy; 


procedure  Clear  (The_Queue  :  in  out  Queue)  is 
begin 

The_Queue  :=  Queue ' (The„Front  =>  null, 
The_Back  =>  null) ; 

end  Clear ; 


procedure  Add  (The_Item  :  in  Item; 

To_The_Queue  :  in  out  Queue)  is 
Previous  :  Structure; 

Index  ;  Structure  :=  To_The_Queue . The_Front ; 
begin 

if  To_The_Queue . The_Fr ont  =  null  then 

To_The_Queue.The_Front  ;=  new  Node ' (The_I tern  =>  The_Item, 

Next  =>  null); 

To_The_Queue . The_Back  :=  To_The_Queue . The_Fr ont ; 

else 

while  (Index  /=  null)  and  then 
(Priority_Of (The_Item)  <= 

Prior ity_Of  ( Index .  The_I tern ) )  loop 
Previous  :=  Index; 

Index  :=  Index. Next; 
end  loop; 

if  Previous  =  null  then 

To_The_Queue . The_Front  : = 

new  Node ’ {The_Item  =>  The_Item, 

Next  =>  Index) ; 

if  To_The_Queue . The_Back  =  null  then 

To_The_Queue . The_Back  :=  To_The_Queue . The_Front ; 
end  if; 

elsif  Index  =  null  then 

To„The_Queue . The_Back  .Next  :  =  new  Node '  { The_I t em  =  > 


The_Item, 


Next  => 


To_The_Queue . The_Back  To_The_Queue . The^Back , Next ; 

else 

Previous  .Next  :=  new  Node '  (The_Item  =>  The_Item, 

Next  =>  Index) ; 

end  if; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 

end  Add; 


procedure  Pop  (The_Queue  :  in  out  Queue)  is 


begin 

The_Queue . The_Front  :=  The_Queue.The_Fr ont .Next; 
if  The_Queue . The_Front  =  null  then 
Thc_Queue . The_Back  i-  null; 
end  if; 
exception 

when  Const  rain  t_Err  or  =;> 
raise  Underflow; 

end  Pop; 

procedure  Remove_Item  ( FroituThe_Queue  :  in  out  Queue; 

At_The_Position  ;  in  Positive)  is 
Count  ;  Natural  :=  1; 

Previous  :  Structure ; 

Index  ;  Structure  ;=  From_The_Queue . The_Front ; 
begin 

while  Index  /=  null  loop 

if  Count  =  At_The_Position  then 
exit ; 

else 

Count  ;=  Count  +1; 

Previous  ;=  Index; 

Index  : =  Index . Next ; 
end  if; 
end  loop; 

if  Index  =  null  then 

raise  Position^Error; 
elsif  Previous  =  null  then 

FronuThe_Queue.The_Front  :=  Index. Next; 

else 

Previous. Next  :=  Index. Next; 
end  if; 

if  Fron\_The_Queue .  The^Back  =  Index  then 
FrortuThe_Queue.The_Back  :=  Previous; 
end  if; 

end  Remove_Item; 

modified  by  Tuan  Nguyen 
replacing  functions  with  procedures 

procedure  Is_Equal  (Left 
Right 
Result 

begin 

Result  :=  Is_Egual (Left, Right ) ; 
end  Is_Equal; 

procedure  Length_0f  (The_Queue 
Result 

begin 

Result  : =  Leng th_Of ( The_Queue ) ; 
end  Length_0f; 

procedure  Is_Eripty  (The_Queue 

Result 

begin 

Result  :  =  Is_Einpty  ( The_Queue )  ; 
end  Is^Enpty; 

procedure  Front_Of  {The_Queue 

Result 

begin 

Result  :=  Front_Of (The^Queue) ; 
end  Front_Of; 

procedure  Position_Of  (The_Item 

In_The_Queue 
Result 

kjegin 

Result  :=  Position_Of (The_Item, In_The_Queue) ; 
end  Position_Of; 

end  of  modification 

function  Is_Equal  (Left  :  in  Queue; 

Right  :  in  Queue)  return  Boolean  is 
Left_Index  :  Structure  :=  Left.The_Front; 

Right_Index  :  Structure  :=  Right .The_Fr ont ; 
begin 

while  Left_Index  /=  null  loop 

if  Left_Index.The_Item  /=  Right_Index.The_Item  then 
return  False ; 

else 

Left_Index  :=  Left_Index.Next ; 

Right_Index  :s:  Right_Index.Next ; 
end  if; 
end  loop; 

return  (Right_Index  =  null) ; 
exception 

when  Constraint_Error  => 
return  False; 
end  Is^Egual; 

function  Length_Of  {The_Queue  :  in  Queue)  return  Natural  is 
Coxint  :  Natural  :=  0; 

Index  :  Structure  :=  The_Queue . The_Front ; 
begin 

while  Index  /=  null  loop 


:  in  Queue ; 

;  in  Queue ; 

;  out  Boolean)  is 


:  in  Queue; 

:  out  Natural)  is 


:  in  Queue ; 

:  out  Boolean)  is 


;  in  Queue; 
;  Item)  is 


:  in  Item; 

:  in  Queue; 

:  out  Natural)  is 
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Count  :=  Coxant  *  1; 

Index  ; =  Index . Next ; 
end  loop; 
return  Count; 
end  Length^Of; 

function  Is^Errpty  (The^Queue  :  in  Queue)  return  Boolean  is 
begin 

return  (The_Queue,The_Front  »  null) ; 
end  Is_Eitipty; 

function  Front_Of  (The_Queue  :  in  Queue)  return  Item  is 
begin 

return  The_Queue . The_Fr ont . The_I tern; 
exception 

when  Constraint^Error  =s> 
raise  Underflow; 
end  Front_Of; 

function  Position_Of  (The_Item  :  in  Item; 

In_The_Queue  :  in  Queue)  return  Natural  is 
Position  :  Natural  :=  1; 

Index  :  Structure  :=  In_The_Queue . The_Front ; 
begin 


while  Index  /=  null  loop 

if  Index. The_I tern  =  The_,Item  then 
return  Position; 

else 

Position  Position  +  1; 

Index  ;=  Index. Next; 
end  if; 
end  loop; 
return  0; 
end  Position_0f; 

procedure  Iterate  (Over_The_Queue  :  in  Queue)  is 

The_Iterator  :  Structure  ;=  Over_The_Queue . The^Front ; 
Continue  :  Boolean; 
begin 

while  not  (The„Iterator  =  null)  loop 

Process (The_I terator . The_Item,  Continue ) ; 
exit  when  not  Continue; 

The^Iterator  ;=  The_I terator .Next; 
end  loop; 
end  Iterate; 

end  Queue_Pr ior ity_Balking_Seguential_Unboxinded_Unmanaged_Iterator ; 
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QUEUE  PRIORITY  BALKING  SEQUENTIAL  UNBOUNDED  UNMANAGED  ITERATOR 

PSDL 


TVPE  Queue_Pr iority_Balking__Sequent ial_Unbounded^Unmanaged_I terator 

SPECIFICATION 

GENERIC 

Item  :  PRIVATE_TYPE, 

Priority  :  PRIVATE_TYPE, 

Priority_Of  :  FUNCTION [The_I tern  ;  Item,  RETURN  ;  Priority] , 
func_"<="  :  FUNCTION  {Left  :  Priority,  Right  ;  Priority,  RETURN 
Boolean] 

OPERATOR  Copy 
SPECIFICATION 
INPUT 

From_The_Queue  ;  Queue , 

To_The_Queue  :  Queue 
OUTPUT 

To_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Queue  :  Queue 
OUTPUT 

The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Add 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

To_The_Queue  :  Queue 
OUTPUT 

To_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position^Error 

END 

OPERATOR  Pop 
SPECIFICATION 
INPUT 

The_Queue  :  Queue 
OUTPUT 

The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Remove_Item 
SPECIFICATION 
INPUT 

FrortuThe__Queue  :  Queue , 

At_The_Position  :  Positive 
OUTPUT 

From_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Is^Equal 
SPECIFICATION 
INPUT 


Left  :  Queue, 

Right  ;  Queue 
OUTPUT 

Result  ;  Boolean 
EXCEPTIONS 

Overflow,  Underflow,  Position^Error 

END 

OPERATOR  Length_Of 

SPECIFICATION 

INPUT 

The_Queue  t  Queue 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Is_Einpty 

SPECIFICATION 

INPUT 

The^Queue  :  Queue 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Front_Of 

SPECIFICATION 

INPUT 

The_Queue  :  Queue, 

Result  :  Item 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Position^Of 

SPECIFICATION 

INPUT 

The_Item  ;  Item, 

In^The_Queue  :  Queue 
OUTPUT 

Result  ;  Natural 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Iterate 

SPECIFICATION 

GENERIC 

Process  :  PROCEDURE [The_I tern  :  inU  :  Item],  Continue  :  out[t 

Boolean] ] 

INPUT 

Over_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

END 

IMPLEMENTATION  ADA 

Queue_Priority_Balking_Seguential_Unbounded_Unmanaged_Iterator 

END 
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QUEUE  PRIORITY  NONBALKING  SEQUENTIAL  UNBOUNDED  UNMANAGED  ITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

type  Priority  is  limited  private; 

with  function  Priority_Of  {The_Item  :  in  Item)  return 
Priority; 

with  function  •<="  (Left  :  in  Priority; 

Right  ;  in  Priority)  return  Boolean; 

package 

Queue_Pr  ior  i  ty_JIonbalking_Sequent  i  al_Unboundedu.Uninanaged_I  ter  a  tor  xs 
type  Queue  is  limited  private; 

procedure  Copy  ( FroiiL.The_Queue  ;  in  Queue; 

To_The_Queue  ;  in  out  Queue) ; 
procedure  Clear  {The_Queue  :  in  out  Queue) ; 

procedure  Add  (The_Item  :  in  Item; 

To_The_Queue  :  in  out  Queue) ; 
procedure  Pop  {The_Queue  :  in  out  Queue) ; 

—  modified  by  Tuan  Nguyen 

—  replacing  functions  with  procedures 

procedure  Is_Egual  (Left  :  in  Queue; 

Right  ;  in  Queue; 

Result  :  out  Boolean) ; 

procedure  Length_Of  (The_Queue  ;  in  Queue; 

Result  :  out  Natural) ; 

procedure  Is^Enpty  {The_Queue  :  in  Queue; 

Result  :  out  Boolean) ; 


procedure  Front_Of  (The^Queue  :  in  Queue; 

Result  :  Item)  ; 

—  end  of  modification 

function  Is_Equal  (Left  :  in  Queue; 

Right  :  in  Queue)  return  Boolean; 

function  Length_Of  (The_Queue  :  in  Queue)  return  Natural ; 

function  Is^Enpty  (The_Queue  ;  in  Queue)  return  Boolean; 

fxinction  Front_Of  (The_Queue  :  in  Queue)  return  Item; 

generic 

with  procedure  Process  (The_Item  ;  in  Item; 

Continue  :  out  Boolean) ; 
procedure  Iterate  (Over_The_Queue  :  in  Queue) ; 

Overflow  :  exception; 

Underflow  :  exception; 

private 

type  Node; 

type  Structure  is  access  Node; 
type  Queue  is 
record 

The_Front  ;  Structure; 

The_Back  :  Structure; 
end  record; 

end  Queue_Prior ityJNonbalking_Seguential_Unbounded_Unmanaged_Iterator 
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QUEUE  PRIORITY  NONBALKING  SEQUENTIAL  UNBOUNDED  UNMANAGED  ITERATOR 

ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Nuiriber  0100219 

"Restricted  Rights  Legend" 

--  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  {3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Computer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer; 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  {1-303-987-1874) 

package  body 

Queue_Priority_Nonbalking_Seguential__Unbounded_Uninanaged_Iterator 

is 


type  Node  is 
record 

The_Item  :  Item; 

Next  :  Structure ; 

end  record; 


procedure  Copy  (Fron\_The_Queue  :  in  Queue; 

To_The_Queue  :  in  out  Queue)  is 
Fronuindex  :  Structure  :=  FroitL.The_Queue  .The_Front; 
To_Index  ;  Structure; 
begin 

if  FroituThe_Queue .  The^Front  =  null  then 
To_The_Queue . The_Front  :=  null; 
To_The_Queue.The_Back  :=  null; 

else 

To_The_Queue . The_Front  : = 

new  Node'  (The_Item  =>  Fron\_Index.The_Item, 

Next  =>  null); 

To_The_Queue .  The_Back  :  =  To_The_Queue .  The_Front  ; 
To_Index  :=  To_The_Queue . The_Front ; 

Fronulndex  :=  Fr om^Index , Next ; 
while  Fronuindex  /=  null  loop 

To_Index.Next  ;=  new  Node '  {The_Item  => 


From_Index .  The_Item, 


Next  =>  null) ; 


To_Index  :=  To_Index.Next ; 
FroiTL.Index  :=  From^Index .  Next ; 
To_The_Queue.The_Back  :=  To_Index; 
end  loop; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Copy; 


procedure  Clear  {The_Queue  :  in  out  Queue)  is 
begin 

The_Queue  :=  Queue’ (The_Front  =>  null, 
The^Back  =>  null) ; 

end  Clear; 


procedure  Add  (The^Item  :  in  Item; 

To_The_Queue  :  in  out  Queue)  is 
Previous  :  Structure; 

Index  :  S  true  fore  :=  To_The_Queue .  The_Front ; 
begin 

if  To_The_Queue.The_Front  =  null  then 

To_The_Queue.The_Front  :=  new  Node'  (The^Item  ==>  The^Item, 
““  Next  =>  null)  ; 

To_The„Queue  -  The_Bac  k  :  =  To_The_Queue .  The_Front ; 

else 

while  (Index  /=  null)  and  then 
( Priori ty_Of (The_Item)  <= 

Prior  ity_Of  ( Index .  The_Item) )  loop 
Previous  :=  Index; 

Index  :=  Index. Next ; 
end  loop; 

if  Previous  =  null  then 

To_The_Queue . The^Front  : = 

new  Node'  {The^Item  =>  The_Item, 

Next  =>  Index)  ; 
if  To_The_Queue .The_Back  =  null  then 

To_The_Queue.The_Back  :=  To_The_Queue . The_Front ; 
end  if; 

els if  Index  =  null  then 

To_The_Queue,The_Back.Next  :=  new  Node '  (The_Item  => 


The^Item, 


Next  => 


To_The_Queue.'Ihe_Back  :«  To_The_Queue .The_Back.Next ; 

else 

Previous . Next  :=  new  Node' (The_I tern  =>  The_Item, 

Next  =>  Index) ; 

end  if; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 

end  Add; 


procedure  Pop  (The^Queue  ;  in  out  Queue)  is 
begin 

The_Queue .  The_Fr ont  :  =  The_Queue .  The_Fr ont .  Next  ; 
if  The_Queue . The_Front  =  null  then 
The_Queue . The_Back  : =  null ; 
end  if; 
exception 

when  Constraint_Error  => 
raise  Underflow; 

end  Pop; 

—  modified  by  Tuan  Nguyen 
--  replacing  fimctions  with  procedures 

procedure  Is_Egual  (Left 
Right 
Result 

begin 

Result  :=  Is_Egual (Left, Right) ; 
end  Is_Equal; 

procedure  Length_0f  (The_Queue 
Result 

begin 

Result  :s  Length_0f (The^Queue) ; 
end  Length_0f; 

procedure  Is_Enpty  {The_Queue 

Result 

begin 

Resul  t  :  =  Is^Eitp ty  ( The^Queue )  ; 
end  Is_Errpty; 

procedure  Front_Of  (The^Queue 

Result 

begin 

Result  :=  Front^Of (The_Queue) ; 
end  Front_Of; 

—  end  of  modification 

function  Is_Equal  (Left  :  in  Queue; 

Right  :  in  Queue)  return  Boolean  is 
Left^Index  :  Structure  :=  Lef t .The_Front ; 

Right_Index  :  Structure  :=  Right . The_Front ; 
begin 

while  Left_Index  /=  null  loop 

if  Left_Index.The_Itein  /=  Right_Index.The_Item  then 
return  False; 

else 

Left_Index  ;=  Lef t_Index. Next; 

Right^Index  :=  Right_Index.Next ; 
end  if; 
end  loop; 

return  (Right_Index  =  null) ; 
exception 

when  Constraint_Error  => 
return  False; 
end  Is_Equal; 

fxinction  Length_Of  (The_Queue  :  in  Queue)  return  Natural  is 
Count  :  Natural  :=  0; 

Index  :  Structure  :=  The_Queue . The_Fr ont ; 
begin 

while  Index  /=  null  loop 
Count  ;=  Count  +  1; 

Index  :=  Index. Next; 
end  loop; 
return  Co^mt; 
end  Length_Of ; 

function  Is_Eiipty  (The_Queue  :  in  Queue)  return  Boolean  is 
begin 

return  (The_Queue.The_Front  =  null) ; 
end  Is_Enpty; 

function  Front_Of  (The_Queue  :  in  Queue)  return  Item  is 
begin 

retvim  The_Queue .  The_Front .  The^Item; 
exception 

when  Constraint_Error  => 
raise  Underflow; 
end  Front_Of; 

procedure  Iterate  ( Over^The_Queue  :  in  Queue)  is 

The_Iterator  :  Structure  Over_The_Queue .  The_Front  ; 

Continue  :  Boolean ; 

begin 

while  not  (The_Iterator  =  null)  loop 

Process (The_Iterator .The_Item,  Continue ) ; 
exit  when  not  Continue; 

The_Iterator  :=  The_Iterator .Next; 
end  loop; 
end  Iterate; 

end  Queue_Prior i ty_Nonbalking_Seguential_UnboundedLUninanaged_I terator 


:  in  Queue ; 

:  in  Queue; 

:  out  Boolean)  is 


:  in  Queue ; 

;  out  Natural)  is 


:  in  Queue ; 

:  out  Boolean)  is 


;  in  Queue ; 
:  Item)  is 
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QUEUE  PRIORITY  NONBALKING  SEQUENTIAL  UNBOUNDED  UNMANAGED  ITERATOR 


PSDL 


TYPE  Queue_Priority_Nonbalking_Sequential_UnboxjiidecLUnmcinaged_Iterator 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TyPE , 

Priority  :  PRIVATE_TYPE, 

Priori ty_Of  :  FUNCTION [The_I tern  :  Item,  RETURN  :  Priority)  , 
func_"<="  :  FUNCTION ILeft  :  Priority,  Right  :  Priority,  RETURN  : 
Boolean] 

OPERATOR  Copy 
SPECIFICATION 
INPUT 

Fron\_The_Queue  :  Queue, 

To_The_Queue  :  Queue 
OUTPUT 

To_The_Queue  ;  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Queue  :  Queue 
OUTPUT 

The_Queue  ;  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Add 
SPECIFICATION 
INPUT 

The_Item  ;  Item, 

To_The_Queue  :  Queue 
OUTPUT 

To_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Pop 
SPECIFICATION 
INPUT 

The_Queue  :  Queue 
OUTPUT 

The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Is_Equal 
SPECIFICATION 
INPUT 


Left  :  Queue, 

Right  :  Queue 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Length_Of 

SPECIFICATION 

INPUT 

The^Queue  :  Queue 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Is_Empty 

SPECIFICATION 

INPUT 

The_Queue  :  Queue 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Front_Of 

SPECIFICATION 

INPUT 

The_Queue  :  Queue, 

Result  :  Item 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Iterate 

SPECIFICATION 

GENERIC 

Process  :  PROCEDURE [The^I tern  :  in[t  :  Item],  Continue  :  out(t 

Boolean] ] 

INPUT 

Over_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

END 

IMPLEMENTATION  ADA 

Queue_Priority_Nonbalking_Sequential_UnboundecLUninanaged_Iterator 

END 
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QUEUE  NONPRIORITY  BALKING  SEQUENTIAL  UNBOUNDED  MANAGED  ITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 
package 

Queue^Nonpr iori ty_Balking^Sequential_Unbounde<01anaged_I tera tor  is 
type  Queue  is  limited  private; 

procedure  Copy  ( From_The_Queue  ;  in  Queue; 

To_The_Queue  :  in  out  Queue); 

procedure  Clear  (The^Queue  :  in  out  Queue); 

procedure  Add  (The_Item  :  in  Item; 

To_The_Queue  :  in  out  Queue); 

procedure  Pop  {The_Queue  :  in  out  Queue); 

procedure  Remove_Item  { FroiiL.The_Queue  :  in  out  Queue; 

At_The_Position  :  in  Positive) ; 

—  modified  by  Tuan  Nguyen 

—  replacing  functions  with  procedures 

procedure  Is_Equal  (Left  :  in  Queue; 

Right  :  in  Queue; 

Result  :  out  Boolecui) ; 

procedure  Length_Of  {The_Queue  :  in  Queue; 

Result  :  out  Natural); 

procedure  Is_En5>ty  tThe_Queue  :  in  Queue; 

Result  :  out  Boolean) ; 

procedure  Front_Of  (The_Queue  :  in  Queue; 

Result  :  Item) ; 

procedure  Position_Of  (The^Item  :  in  Item; 

In_The_Queue  ;  in  Queue; 


Result  ;  out  Natural ) ; 

—  end  of  modification 

function  Is_Equal  (Left  :  in  Queue; 

Right  :  in  Queue)  return  Boolean; 

function  Length_Of  (The_Queue  :  in  Queue)  return  Natural; 

function  Is_Enpty  (The_Queue  :  in  Queue)  return  Boolean; 

fimction  Front^Of  (The_Queue  :  in  Queue)  return  Item; 

function  Position_Of  (The_Item  :  in  Item; 

In_The„Queue  :  in  Queue)  return  Natural; 

generic 

with  procedure  Process  (The_Item  :  in  Item; 

Continue  :  out  Booleain)  ; 
procedure  Iterate  { Over_The_Queue  :  in  Queue) ; 

Overflow  :  exception; 

Underflow  :  exception; 

Position_Error  :  exception; 

private 

type  Node; 

type  Structure  is  access  Node; 
type  Queue  is 
record 

The_Front  :  Structure; 

The_Back  :  Structure; 
end  record; 

end  Queue_Nonpr iority_Balking_Sequential_UnboundedJWanaged_Iterator ; 
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QUEUE  NONPRIORITY  BALKING  SEQUENTIAL  UNBOUNDED  MANAGED  ITERATOR 

ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

“Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Cort?3uter 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

with  Storage^anager_Sequential; 
package  body 

Queue_JJonpriority_Balking_Sequential_Unbounded^Mcmaged_Iterator  is 

type  Node  is 
record 

The_Item  :  I tern; 

Next  ;  Structure; 

end  record; 

procedure  Free  {The_^ode  :  in  out  Node)  is 
begin 

null; 
end  Free; 

procedure  Set^Next  (The^Node  :  in  out  Node; 

To_Next  :  in  Structure)  is 

begin 

The_Node  .Next  ;=  ToJtJext; 
end  Set_JText; 

function  Next_Of  (The_Node  :  in  Node)  return  Structure  is 
begin 

return  The_Node.Next; 
end  Next_Of; 

package  Node_Manager  is  new  StorageJManager_Sequential 

(Item  =>  Node, 

Pointer  =>  Structure, 

Free  =>  Free, 

Set_Pointer  =>  Set_Next, 
Pointer„Of  =>  Next_0f ) ; 

procedure  Copy  ( From_The_Queue  :  in  Queue; 

To_The_Queue  ;  in  out  Queue)  is 
From_Index  :  Structure  :=  FroiiuThe_Queue .  The_Front  ; 
To^Index  :  Structure ; 
begin 

NodeJManager . Free ( To_The_Queue . The_Front  > ; 
To_The_Queue.The_Back  ;=  null; 
if  FroiiL.The_Queue .  The_Front  /=  null  then 

To_The_Queue .  The_Fr ont  :  =  Node_Manager .  New_I tern; 
ToZThelQueue.TheZsack  :=  To_The_Queue-The_Front; 
To_The_Queue.The_Front .The_Item  :=  From^Index.The_Item; 
To^Index  : =  To_The_Queue - The_Front ; 

Froit\_Index  :=  Fron\_Index.Next ; 
while  Fronuindex  /=  null  loop 

To_lndex.Next  :=  Node_Manager.New_Item; 

ToZindex .Next .The_I tern  ;=  FronuIndex.The_Item; 
To_Index  :=  To_Index.Next ; 

Fronuindex  :=  From_Index.Next; 
To_The_Queue.The_Back  :=  To_Index; 
end  loop; 
end  if; 
exception 

when  Storage^Error  => 
raise  Overflow ,- 
end  Copy; 

procedure  Clear  (The^Queue  :  in  out  Queue)  is 
begin 

Node_Manager . Free ( The_Queue . The_Front ) ; 

The_Queue . The_Back  : =  null ; 
end  Clear; 


procedure  Add  (The_Item  :  in  Item; 

To_The_,Queue  ;  in  out  Queue)  is 

begin 

if  To_The_Queue . The_Front  =  null  then 

To_The_Queue.The_Front  :=  NodeJIanager-New_Item; 
To_TheZQueue.The_Front .The_ltem  :=  The_Item; 
To_The_Queue.The_Back  :=  To_The_Queue . The_Front ; 

else 

To_The_Queue .  The_Back .  Next  ;  =  Node_Manager .  New_I  t em  ; 
To_The_Queue . The^Back . Next , The_I tern : =  The_I tern  ; 
To_The_Queue . The_Back  : =  To_The_Queue . The_Back . Next ; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 

end  Add; 

procedure  Pop  (The^Queue  :  in  out  Queue)  is 
Tenporary_Node  :  Structure; 


begin 

Teniporary_JIode  :=  The_Queue .  The_Front ; 

The_Queue .  The_Front  :  =  The_Queue .  The_Fr ont .  Next ; 
TemporaryJJode .Next  ;=  null; 

NodeJManager  .Free  (Teirporary_Node) ; 
if  ThCjOueue . The_Front  =  null  then 
The_Queue . The_Back  :=  null; 
end  if; 
exception 

when  ConstraintjError  => 
raise  Underflow; 

end  Pop; 

procedure  Remove_Item  (Froii\_ThejQueue  :  in  out  Queue; 

AtjThejPosition  ;  in  Positive)  is 
Count  :  Natural  :=  1; 

Previous  :  Structure; 

Index  :  Structure  :=  FroitL.The_jQueue . The_Front  ; 
begin 

while  Index  /=  null  loop 

if  Count  =  AtjThe_Position  then 
exit; 

else 

Count  ;=  Coiint  +  1; 

Previous  ; =  Index ; 

Index  : =  Index .Next ; 
end  if; 
end  loop; 

if  Index  =  null  then 

raise  Position_Error; 
elsif  Previous  =  null  then 

FroiiuThe_Queue .  The ^Front  :  =  Index .  Next  ; 

else 

Previous .Next  :=  Index. Next; 
end  if; 

if  From_The jQueue . The_Back  =  Index  then 
From_ThejQueue . The_Back  :=  Previous; 
end  if; 

Index .Next  ; =  null ; 

Node^anager .  Free  ( Index)  ; 
end  Remove_Item; 

modified  by  Tuan  Nguyen 
replacing  f\mctions  with  procedures 

procedure  Is_Equal  (Left  :  in  Queue; 

Right  :  in  Queue; 

Result  :  out  Boolean)  is 

begin 

Result  :=  ISjEgual (Left, Right) ; 
end  ISjEqual; 

procedure  Length^Of  (The^Queue  :  in  Queue; 

Result  :  out  Natural)  is 

begin 

Resu It  : »  Leng thjO f ( ThejQueue ) ; 
end  LengthjOf; 

procedure  Is_.Einpty  (The_Queue  :  in  Queue; 

Result  :  out  Boolean)  is 

begin 

Result  :=  ISjEmpty (The_Queue) ; 
end  ISjEmpty; 

procedure  Front_Of  (The_Queue  :  in  Queue; 

Result  :  Item)  is 

begin 

Result  ;=  FrontjOf (The_Queue) ; 
end  FrontjOf; 

procedure  Position_0f  (The_Item  :  in  Item; 

InjThe_Queue  :  in  Queue; 

Result  :  out  Natural)  is 

begin 

Result  :=  Position_0f (The_Item, InjThe_Queue) ; 
end  Position_Of; 

end  of  modification 

function  Is_Equal  (Left  :  in  Queue; 

Right  :  in  Queue)  return  Boolean  is 
Leftjindex  :  Structure  :=  Left .The^Front ; 

Rightjindex  :  Structure  :=  Right . The_Front ; 
begin 

while  Leftjindex  /=  null  loop 

if  LeftjIndex.ThejItem  /=  Right_Index . ThCjItem  then 
return  False; 

else 

LeftjIndex  Lef tjIndex.Next; 

Rightjindex  :=  Right_Index.Next ; 
end  if; 
end  loop; 

return  (Right_Index  =  null) ; 
exception 

when  Cons train tjErr or  => 
return  False; 
end  ISjEqual; 


function  Length_Of  {The^Queue  :  in  Queue)  return  Natural  is 
Count  :  Natural  :=  0; 

Index  :  Structure  :=  The_Queue . The_Fr ont ; 
begin 

while  Index  /=  null  loop 
Coiint  :=  Count  +  1; 

Index  index. Next; 

end  loop; 
return  Count; 
end  Length^Of; 

function  Is„En?)ty  (The^Queue  :  in  Queue)  return  Boolean  is 
begin 

return  (The_Queue .The_Front  =  null); 
end  Is_Etnpty; 

function  Front^Of  (The_Queue  :  in  Queue)  return  Item  is 
begin 

return  The_Queue .  The_Front ,  The_I tem  ; 
exception 

when  Cons t rain t_Error  => 
raise  Underflow; 
end  Front_0f; 

function  Posit ion_0f  (The_Item  :  in  Item; 

In_The_Queue  :  in  Queue)  return  Natural  is 


Position  :  Natural  :=  1; 

Index  :  Structure  :=  In_The_Queue . The_Front ; 
begin 

while  Index  /=  null  loop 

if  Index. The_I tem  =  The_Item  then 
return  Position; 

else 

Position  :=  Position  +  1; 

Index  :=  Index. Next; 
end  if; 
end  loop; 
return  0; 
end  PositionwOf; 

procedure  Iterate  {Over_The_Queue  :  in  Queue)  is 

The_Iterator  :  Structure  :=  Over_The_Queue . The_Front  ; 
Continue  :  Boolean; 

begin 

while  not  (The_Iterator  =  null)  loop 

Process ( The_Iterat or .The_I tem.  Continue) ; 
exit  when  not  Continue; 

The^Iterator  :=  The_Iterator .Next; 
end  loop; 
end  Iterate; 

end  Queue JNonpriority_Bal]cing_Sequential_Unbounded_JlanagecLI tera tor 
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QUEUE  NONPRIORITY  BALKING  SEQUENTIAL  UNBOUNDED  MANAGED  ITERATOR 


PSDL 


TyPE  Queue_J^onprior i ty_Balking_Sequent ial_Uiibounde<iJManaged_I terator 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

FronuThe^Queue  :  Queue, 

To_The_Queue  :  Queue 
OUTPUT 

To_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position^Error 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Queue  :  Queue 
OUTPUT 

The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Add 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

To_The_Queue  ;  Queue 
OUTPUT 

To_The_Queue  ;  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position^Error 

END 

OPERATOR  Pop 
SPECIFICATION 
INPUT 

The_Queue  :  Queue 
OUTPUT 

The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Remove_Item 
SPECIFICATION 
INPUT 

FroiruThe_Queue  :  Queue, 

At_The^Position  :  Positive 
OUTPUT 

Fromjrhe_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Is_Equal 
SPECIFICATION 
INPUT 

L,eft  :  Queue, 

Right  :  Queue 


OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Length_Of 

SPECIFICATION 

INPUT 

The_Queue  :  Queue 
OUTPUT 

Result  ;  Natural 
EXCEPTIONS 

Overflow,  Underflow,  Position^Error 

END 

OPERATOR  Is_Einpty 

SPECIFICATION 

INPUT 

The_Queue  :  Queue 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Front^Of 

SPECIFICATION 

INPUT 

The^Queue  :  Queue , 

Result  :  Item 
EXCEPTIONS 

Overflow,  Underflow,  Positioti_Error 

END 

OPERATOR  Position_Of 

SPECIFICATION 

INPUT 

The_Item  :  Item, 

In_The_Queue  :  Queue 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Iterate 

SPECIFICATION 

GENERIC 

Process  :  PROCEDURE I Th€_Item  :  init  :  Item],  Continue  :  outit 
Boolean] 1 
INPUT 

Over_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

END 

IMPLEMENTATION  ADA 

Queue_Nonpr  iori  ty_Balking_Sequential_Uiibo\jnded_Managed_I  terator 
END 
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QUEUE  NONPRIORITY  BALKING  SEQUENTIAL  UNBOUNDED  UNMANAGED  NONITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 
package 

Queue  J^onpr  i  or  i  ty_Balking_Sequen  t  ia  l^UnboundecLUnmanaged^Non  1 1  er  a  t  or 

is 

type  Queue  is  limited  private; 

procedure  Copy  ( From_The_Queue 

To_The_Queue 

procedure  Clear  (The_Queue 

procedure  Add  (The_ltem 

To„The_Queue 

procedure  Pop  (The_Queue 

procedure  Remove_Item  ( Fronv_The_Queue 
At_The_Pos i tion 

—  modified  by  Tuan  Nguyen 

—  replacing  functions  with  procedures 

procedure  Is_Egual  (Left  :  in  Queue; 

Right  :  in  Queue; 

Result  :  out  Boolean) ; 

procedure  Length_Of  (The_Queue  :  in  Queue; 

Result  :  out  Natural); 

procedure  Is_En^ty  (The^Queue  :  in  Queue; 

Result  :  out  Boolean) ; 

procedure  Front^Of  (The^Queue  :  in  Queue; 

Result  :  Item) ; 


:  in  Queue; 

:  in  out  Queue); 

:  in  out  Queue); 

:  in  Item; 

:  in  out  Queue) ; 

:  in  out  Queue ) ; 

:  in  out  Queue; 

:  in  Positive) ; 


procedure  Position_Of  (The_Item  :  in  Item; 

In_The_Queue  :  in  Queue; 

Result  :  out  Natural) ; 

—  end  of  modification 

function  Is^Ec[ual  (Left 
Right 

function  Length_Of  (The_Queue 

function  Is_Enpty  (The_Queue 

function  Front_Of  (The_Queue 

function  Position_Of  (The_Item 

In^The_Queue 

Overflow  :  exception ; 

Underflow  ;  exception; 

Position^Error  :  exception; 

private 

type  Node; 

type  Structure  is  access  Node; 
type  Queue  is 
record 

The_Front  :  Structure; 

The_Back  :  Structure ; 
end  record; 

end 

Queue_JNonpriority_Balking„Sequent  ial_Unbounded_Unmanaged_Noni  terator 


;  in  Queue; 

:  in  Queue)  return  Boolean; 

:  in  Queue)  return  Natural ; 

;  in  Queue)  return  Boolean; 

;  in  Queue)  return  Item; 

:  in  Item; 

:  in  Queue)  return  Natural; 
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QUEUE  NONPRIORITY  BALKING  SEQUENTIAL  UNBOUNDED  UNMANAGED  NONITERATOR 

ADA  IMPLEMENTATION 


--  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Ntimber  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Conputer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body 

Queue_Monpr  ior  i  ty_Balking_Sequen  t  ia  l_Unbounded_Uninanage(l_Noni  ter  a  tor 
is 


else 

Count  :=  Count  +  1; 

Previous  :=  Index; 

Index  : =  Index .Next ; 
end  if; 
end  loop; 

if  Index  =  null  then 

raise  Position_Error; 
elsif  Previous  =  null  then 

FroiiL_The_Queue.The_Front  :=  Index. Next; 

else 

Previous. Next  :=  Index. Next; 
end  if; 

if  FronL.The_Queue.The_Back  =  Index  then 
FrortL.The_Queue.The_Back  :=  Previous; 
end  if; 

end  Remo ve_I tern; 


type  Node  is 
record 

The_Item  :  I tern; 

Next  :  Structure; 
end  record; 


procedure  Copy  ( FronuThe_Queue  :  in  Queue; 

To_The_Queue  ;  in  out  Queue)  is 
From_Index  :  Structure  :=  Proin_The_Queue . The_Front ; 
To_lndex  ;  Structure; 
begin 

if  From_The_Queue . The_Front  =  null  then 
To_The_Queue . The_Front  : =  null ; 

To_The_Queue , The_Back  ;=  null; 

else 


To_The_Queue.The_Front  := 

new  Node'  (The_Item  =>  From_Index.The_Item, 

Next  =>  null) ; 

To_The_Queue . The^Back  : =  To_The_Queue , The_Fr on  t ; 
To^Index  ;=  To_The_Queue . The_Front ; 

Frortuindex  :=  From^Index.Next ; 
while  From_Index  /=  null  loop 

To_Index.Next  :=  new  Node  * (The_I tern  => 
Froiruindex .  The_I  t  em , 

Next  =>  null); 


To_Index  :=  To_Index.Next; 
Fronulndex  :=  From_Index.Next; 
To.._The_Queue .  The_Back  :  =  To^Index  ; 
end  loop; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Copy; 


modified  by  Tuan  Nguyen 
replacing  functions  with  procedures 

procedure  Is^Equal  (Left  :  in  Queue; 

Right  :  in  Queue; 

Result  ;  out  Boolean)  is 

begin 

Result  :=  Is_Equal(Left, Right) ; 
end  Is_Egual; 


procedure  Length-Of  (The_Queue  :  in  Queue; 

Result  :  out  Natural)  is 

begin 

Result  :=  Length_Of (The^Queue) ; 
end  Length-Of; 

procedure  Is_Eitpty  (The_Queue  :  in  Queue; 

Result  ;  out  Boolean)  is 

begin 

Result  ;  =  I s_Ernp ty  ( The_Queue ) ; 
end  Is_En^ty; 


procedure  Front_0f  (The_Queue  :  in  Queue; 

Result  :  Item)  is 

begin 

Result  : =  Fr ont_0 f ( The_Queue ) ; 
end  Front_jOf; 


procedure  Position_Of 


(The_Item 

In_The_Queue 

Result 


in  Item; 
in  Queue; 
out  Natural) 


begin 

Resu 1 t  ; =  Pos i t ion_Of { The_I t em , In_The_Queue ) ; 
end  PositionjOf; 


is 


procedure  Clear  (The_Queue  :  in  out  Queue)  is 
begin 

The_Queue  :=  Queue' (The_Front  =>  null, 
The_Back  =>  null) ; 

end  Clear; 


procedure  Add  {The_Item  :  in  Item; 

To_The_Queue  :  in  out  Queue)  is 


begin 

if  To_The_Queue . The_Front  «  null  then 

To_The_Queue.The_Front  :=  new  Node*  (The_Item  =>  The_Item, 

Next  =>  null) ; 

To_The_Queue . The_Back  :=  To_The_Queue.The_Front; 


else 

To_The_Queue . The_Back . Next 


new  Node  * (The_Item  => 


The_Item, 


To_The_Queue . The_Back 
end  if; 
exception 

when  Storage_Error  «=> 
raise  Overflow; 


Next  =>  null); 
To._The^Queue .  The_Back .  Next ; 


end  Add; 


procedure  Pop  (The_Queue  :  in  out  Queue)  is 
begin 

The_Queue . The_Fr on t  : =  The_Queue . The_Fr on t . Next ; 
if  The_Queue - The_Front  =  null  then 
The_Queue . The_Back  :=  null; 
end  if; 
exception 

when  Cons train t_Error  => 
raise  Underflow; 

end  Pop; 

procedure  Remove^Item  ( Fron\jnie_Queue  :  in  out  Queue; 

At_Tbe_Position  :  in  Positive)  is 
Count  :  Natural  :=  1; 

Previous  :  Structure; 

Index  :  Structure  :=  FrorcL_The_Queue  .The^Front; 
begin 

while  Index  /=  null  loop 

if  Count  =  At^The_Position  then 
exit  ; 


end  of  modification 

fxinction  Is_Equal  (Left  :  in  Queue; 

Right  :  in  Queue)  return  Boolean  is 
Left_Index  Structure  :=  Left  .The_Front ; 

Right_lndex  :  Structure  ;=  Right . The_Front ; 
begin 

while  Left_Index  /=  null  loop 

if  Left_Index.The_Item  /=  Right_Index . The_Item  then 
return  False; 

else 

Left_Index  :=  Left_Index.Next; 

Right_Index  ;=  Right^Index.Next ; 
end  if; 
end  loop; 

return  (Right^Index  =  null); 
exception 

when  Constraint_Error  => 
return  False; 
end  Is_Equal; 

function  Length_Of  (The_Queue  :  in  Queue)  return  Natural  is 
Count  :  Natural  :=  0; 

Index  :  Structure  The_Queue . The_Front ; 
begin 

while  Index  /=  null  loop 
Coimt  Count  4  1; 

Index  :=  Index. Next ; 
end  loop; 
return  Count; 
end  Length^Of; 

function  Is_Errpty  (The_Queue  :  in  Queue)  return  Boolean  is 
begin 

return  (The_Queue.The_Front  =  null); 
end  Is_Etrpty; 

function  Front_0f  (The_Queue  :  in  Queue)  return  Item  is 
begin 

return  The_Queue.The_Front-The_Item; 
exception 

when  Constraint_Error  => 
raise  Underflow; 
end  Front_Of; 
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function  Position_Of  (The_Item  :  in  Item? 

ln_The_Queue  ;  in  Queue)  return  Natural  is 
Position  :  Natural  :=  1; 

Index  ;  Structure  ;=  In_The_Queue . The^Front ? 
begin 

while  Index  /=  null  loop 

if  Index. The_I tern  =  The_Item  then 
return  Position; 

else 


Position  ;=  Position 
Index  : =  Index . Next ; 
end  if; 
end  loop; 
return  0; 
end  Position_0f; 


end 

Queue_Nonpr  ior  i  ty_Balking_Seq[uent  ia  1. 


.Unbounded^UnmanagecUNoni  ter  ator ; 
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QUEUE  NONPRIORITY  BALKING  SEQUENTIAL  UNBOUNDED  UNMANAGED  NONITERATOR 


PSDL 


TYPE 

Queue_JJonpriority_Balking_Sequential_UnboundecfLUnmanaged_Noniterator 

SPECIFICATION 

GENERIC 

Item  :  PRIVATE_TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

From_The_Queue  :  Queue, 

To_The_Queue  ;  Queue 
OUTPUT 

To_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Queue  ;  Queue 
OUTPUT 

The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Add 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

To_The_Queue  :  Queue 
OUTPUT 

To_The„Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Pop 
SPECIFICATION 
INPUT 

The_Queue  :  Queue 
OUTPUT 

The_Queue  ;  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position^Error 

END 

OPERATOR  Remove_Item 
SPECIFICATION 
INPUT 

FroirL.The_Queue  ;  Queue , 

At„The_Position  :  Positive 
OUTPUT 

From_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 


OPERATOR  Is_Equal 

SPECIFICATION 

INPUT 

Left  ;  Queue, 

Right  :  Queue 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Length__Of 

SPECIFICATION 

INPUT 

The_Queue  :  Queue 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  ls_Eirpty 

SPECIFICATION 

INPUT 

The_Queue  :  Queue 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Front_Of 

SPECIFICATION 

INPUT 

The_Queue  :  Queue, 

Result  :  Item 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Position^Of 

SPECIFICATION 

INPUT 

The_Item  :  Item, 

In_The_Queue  :  Queue 
OUTPUT 

Result  ;  Natural 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

END 

IMPLEMENTATION  ADA 

Queue^Nonpr  ior  i  ty_Ba  lking_Se<3uen  t  ial«.Unbounded_Uninanageci_Noni  tera  tor 

END 
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QUEUE  NONPRIORITY  NONBALKING  SEQUENTIAL  UNBOUNDED  UNMANAGED  NONITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 
package 

Queue_Nonpriority_Nonbalking_Seguential_Unbounded_UnmanagedJIonxterato 

r 

is 

type  Queue  is  limited  private; 

procedure  Copy  {From_The_Queue 
To_The_Queue 

procedure  Clear  (The^Queue 
procedure  Add  (The_Item 

To_The_Queue 

procedure  Pop  (The_Queue 

—  modified  by  Tuan  Nguyen 

—  replacing  functions  with  procedures 

procedure  Is^Equal  (Left  :  in  Queue; 

Right  :  in  Queue; 

Result  :  out  Boolecin)  ; 

procedure  Length_Of  {The_Queue  :  in  Queue; 

Result  :  out  Natural) ; 

procedure  Is_En?5ty  (The^Queue  :  in  Queue; 

Result  :  out  Boolean) ; 


:  in  Queue; 

:  in  out  Queue) ; 
:  in  out  Queue); 
:  in  Item; 

:  in  out  Queue); 
:  in  out  Queue) ; 


procedure  Front_Of  (The_Queue  :  in  Queue; 

Result  :  Item) ; 

—  end  of  modification 

function  Is_Equal  (Left 
Right 

f\inction  Length^Of  (The_Oueue 
fiinction  Is_Empty  (The^Queue 
function  Front_Of  (The_Queue 

Overflow  :  exception; 

Underflow  :  exception; 

private 

type  Node; 
type  Structure  is  access  Node; 
type  Queue  is 
record 

The_Front  :  Structure; 

The_Back  :  Structure; 
end  record; 

end 

QueueJNonpr  ior  i  ty_Nonba  Iking^Sequent  i  a  l_Unbounded_UnmanagedJIoni  t  er  a  t  o 


:  in  Queue ; 

:  in  Queue)  return  Boolean; 
;  in  Queue)  return  Natural; 
:  in  Queue)  return  Boolean; 
:  in  Queue)  return  Item; 
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QUEUE  NONPRIORITY  NONBALKING  SEQUENTIAL  UNBOUNDED  UNMANAGED  NONITERATOR 

ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Cort^juter 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body 

QueueJNonpriority_JIonbalking_Sequential_Unbounded_Unnianaged_Noniterato 

r  is 


type  Node  is 
record 

The_Item  :  I  tern; 

Next  :  Structure; 

end  record; 


procedure  Copy  ( FroiruThe_Queue  :  in  Queue; 

To_The_Queue  :  in  out  Queue)  is 
From_Index  ;  Structure  :=  Froii\jrhe_Queue . The_Fr ont ; 
To_Index  :  Structure; 
begin 

if  FronuThe_Queue.The_Front  =  null  then 
To_The_Queue . The_Front  :=  null; 

To_The_Queue . The_Back  : =  null ; 

else 


To_The_Queue . The_Front  : = 

new  Node* (The_Item  =>  From_Xndex.The_Item, 

Next  =>  null) ; 

To_The_Queue . The_Back  : =  To_The_Queue . The_Front ; 
To_Index  : =  To_The_Queue . The_Front ; 

FroirL,Index  :=  Frorn_Index.Next; 
while  From_Xndex  /=  null  loop 

To_Index.Next  :=  new  Node  *  (The^I tern  => 
From_Index ,  The_I  t  em , 


Next  =>  null); 


To_Index  :=  To_Index.Next ; 
From^Index  :  =  Fr  on\_Index .  Next  ; 
To_The_Queue.The_Back  :=  To_Index; 


end  loop; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 


end  Copy; 


procedure  Clear  (The_Queue  :  in  out  Queue)  is 
begin 

The_jQueue  :=  Queue*  (The_Front  =>  null, 
The_Back  =>  null) ; 

end  Clear; 


procedure  Add  (*rhe_Iteni  :  in  Item; 

To_The_Queue  :  in  out  Queue)  is 

begin 

if  To_The_Queue  .'rhe_Front  =  null  then 

To_The_Queue . The_Front  :=  new  Node'  {The_Item  =>  The_Item, 

Next  =>  null) ; 

To_The_Queue . The_Back  ; =  To_The_Queue . The_Front ; 

else 

To_The_Queue .  The_Back .  Next  :  =  new  Node  ’  ( The_I  t  em  => 


The^Item, 


Next  =>  null) ; 


To_The_Queue . The_Back  : =  To_The_Queue . The_Back . Next  ; 
end  if; 
exception 

when  Storage^Error  => 
raise  Overflow; 


end  Add; 


procedure  Pop  (The^Queue  :  in  out  Queue)  is 
begin 

The_Queue . The_Fr ont  : =  The^Queue . The^Front . Next ; 
if  The jQueue . The^Front  =  null  then 
The_.Queue.The_Back  :=  null; 


end  if; 
exception 

when  Constraint_Error  => 
raise  Underflow; 

end  Pop; 

—  modified  by  Tuan  Nguyen 

—  replacing  functions  with  procedures 

procedure  Is_Equal  (Left  :  in  Queue; 

Right  :  in  Queue; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is^Equal (Left, Right ) ; 
end  Is_Equal; 

procedure  Length_0f  (The^Queue  :  in  Queue; 

Result  :  out  Natural)  is 

begin 

Result  ;=  Length_Of  ('The^Queue)  ; 
end  Lengtb-Of; 

procedure  Is_Empty  (The_Queue  :  in  Queue; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is_Empty (The^Queue) ; 
end  Is_Empty; 

procedure  Front_0f  (The_Queue  :  in  Queue; 

Result  :  Item)  is 

begin 

Result  : =  Fr on t_Of ( The^Queue ) ; 
end  Front_Of; 

—  end  of  modification 

function  Is_Equal  (Left  :  in  Queue; 

Right  :  in  Queue)  return  Boolecui  is 
Left_Index  :  Stanacture  :=  Left  .The_Fr ont ; 

Right_Index  ;  Structure  :=  Right . The_Fr ont ; 
begin 

while  Left_Index  /=  null  loop 

if  Left_Index.The_.Item  /=  Right_Index.The_Item  then 
return  False; 

else 

Le  f  t_Index  : =  Le f t_Index . Next ; 

Right_Index  : =  Right_Index . Next ; 
end  if; 
end  loop; 

return  (Right_Index  =  null) ; 
exception 

when  Cons train t_Err or  => 
return  False; 
end  Is_Equal; 

function  Length_0f  (The_Queue  :  in  Queue)  return  Natural  is 
Count  :  Natural  ;=  0; 

Index  :  Structure  :=  The_Queue.The_Front; 
begin 

while  Index  /=  null  loop 
Coxjnt  ;=  Count  +  1; 

Index  :=:  Index. Next; 
end  loop; 
return  Coamt; 
end  LengthwOf; 

function  Is_Eirpty  (The_Queue  ;  in  Queue)  return  Boolean  is 
begin 

return  (The_Queue.The_Front  =  null); 
end  Is_Empty  ; 

famction  Front_Of  (The_Queue  :  in  Queue)  return  Item  is 
begin 

return  The_Queue . The_Front . The_I tem ; 
exception 

when  Constraint_Error  => 
raise  Underflow; 
end  Front_Of; 

end 

Queue_Nonpriority_Nonbalking_Sequential_Unbo\mded_Unmanaged_Nonxterato 
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QUEUE  NONPRIORITY  NONBALKING  SEQUENTIAL  UNBOUNDED  UNMANAGED  NONITERATOR 

PSDL 


Queue_>Jonpriority_Noiibalking_Sequential_Unbotinded_Unmanaged_Noniterato 

r 

SPECIFICATION 

GENERIC 

Item  :  PRIVATE_TYPE 

OPERATOR  Copy 

SPECIFICATION 

INPUT 

FrortuThe_Queue  :  Queue, 

To_The_Queue  :  Queue 
OUTPUT 

To_The„Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Clear 

SPECIFICATION 

INPUT 

The_Queue  :  Queue 
OUTPUT 

The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Add 

SPECIFICATION 

INPUT 

The_Item  :  Item, 

To_The_Queue  :  Queue 
OUTPUT 

To_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Pop 

SPECIFICATION 

INPUT 

The_Queue  :  Queue 
OUTPUT 

The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 


OPERATOR  Is^Equal 

SPECIFICATION 

INPUT 

Left  :  Queue, 

Right  :  Queue 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Length_Of 

SPECIFICATION 

INPUT 

The_Queue  ;  Queue 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Is_Empty 

SPECIFICATION 

INPUT 

The_Queue  :  Queue 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Front_Of 

SPECIFICATION 

INPUT 

The_Queue  :  Queue , 

Result  :  Item 
EXCEPTIONS 

Overflow,  Underflow 

END 

END 

IMPLEMENTATION  ADA 

Queue  JNonpr  ior  x  ty_Nonbalking_Sequent  ial_Unboimded^Unmanaged_Noni  t  er  a  t  o 

r 

END 
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QUEUE  PRIORITY  BALKING  SEQUENTIAL  UNBOUNDED  MANAGED  ITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

type  Priority  is  limited  private; 

with  function  Priority_Of  (The_Item  :  in  Item)  return 

Priority; 

with  function  "<="  (Left  :  in  Priority; 

Right  :  in  Priority)  return  Boolean; 
package  Queue_Priority_Balking_Sequential_Unbounded_Managed_Iterator 
is 


type  Queue  is  limited  private; 


procedure  Copy 

( FroauThe_Queue  ; 

in 

Queue ; 

To_The_Queue  ; 

in 

out 

Queue) ; 

procedure  Clear 

(The_Queue  : 

in 

out 

Queue ) ; 

procedure  Add 

{The_Item  : 

in 

Item; 

To_The_Queue  ; 

in 

out 

Queue) ; 

procedure  Pop 

(The_Queue  : 

in 

out 

Queue ) ; 

procedure  Remove_Item  {Froirt.The_Queue  : 

in 

out 

Queue; 

At_The_Position  : 

in 

Positive) 

modified  Tuan  Nguyen 

replacing  functions 

with  procedures 

procedure  Is_Equal 

(Left  :  in 

Queue; 

procedure  Length_Of 
procedure  Is_Enpty 
procedure  Front^Of 


Right 

Result 

(The^Queue 

Result 

(The_Queue 

Result 

{The_Queue 

Result 


;  in  Queue ; 

:  out  Boolean) ; 
:  in  Queue ; 

:  out  Natural) ; 
:  in  Queue ; 

:  out  Boolean) ; 
:  in  Queue ; 

:  Item)  ; 


procedure  Position^Of  {The_Item  :  in  Item; 

In_The_Queue  :  in  Queue; 
Result  ;  out  Natural); 


end  of  modification 

function  Is_Equal 

(Left  : 

in  (Jueue; 

function  Length_Of 

Right  ; 

in  Queue) 

return 

Boolean; 

(The_Queue  ; 

in  Queue) 

return 

Natural ; 

function  Is_Eirpty 

(The_Queue  : 

in  Queue) 

return 

Boolean; 

function  Front_Of 
function  Position_Of 

(The_Queue  : 

(The_Item  : 

in  Queue) 
in  Item; 

return 

Item; 

generic 

In__The_Queue  ; 

in  Queue) 

return 

Natural ; 

with  procedure  Process  (The_Item 

:  in  Item; 

Continue  ;  out  Boolean) ; 
procedure  Iterate  (Over_The_Queue  :  in  Queue) ; 


Overflow  :  exception; 

Underflow  :  exception; 

Position_Error  :  exception; 

private 

type  Node; 

type  Structure  is  access  Node; 
type  Queue  is 
record 

The_Front  :  Structure; 

The^Back  :  Structure; 
end  record; 

end  Queue_Priority_Balking_Sequential_UnboundedJManaged_Iterator  ; 
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QUEUE  PRIORITY  BALKING  SEQUENTIAL  UNBOUNDED  MANAGED  ITERATOR 


ADA  IMPLEMENTATION 


--  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Nimber  0100219 

“Restricted  Rights  Legend" 

--  Use,  duplication,  or  disclosure  is  subject  to 

restrictions  as  set  forth  in  subdivision  (b)  (3)  (ii) 

_  of  the  rights  in  Technical  Data  and  Computer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  {1-303-987-1874) 

with  storage,Jlanager_Sequential; 

QueuSriority_Balking_Sequential_Unbounded_Managed_Iterator  is 

type  Node  is 
record 

The^Item  :  Item; 

Next  :  Structure; 
end  record; 

procedure  Free  (The_>Iode  :  in  out  Node)  is 
begin 

null; 
end  Free; 

procedure  SetJNext  (TheJIode  :  in  out  Node; 

ToJJext  :  in  Structure)  is 

begin 

The Jlode. Next  To_Next; 

end  SetJNext; 

function  Next_Of  (The^ode  :  in  Node)  return  Structure  is 
begin 

return  The_JJode .Next; 
end  Next_Of; 

package  Node_Nanager  is  new  Storage_Manager_Sequential 

(Item  =>  Node, 

Pointer  =>  Structure, 

Free  =>  Free, 

Set_Po inter  =>  SetJJext, 
Pointer_Of  =>  Next_0f ) ; 

procedure  Copy  (FroitL_The_Queue  :  in  Queue; 

To_The_Queue  ;  in  out  Queue)  is 
From_Index  :  Structure  FronuThe_Queue . The_Front ; 

To^Index  :  Structure; 
begin 

NodeJManager . Free {To_The_Queue . The_Front) ; 

To_The_Queue . The_Back  :=  null; 
if  FronuThe^Queue . The_Front  /=  null  then 

1'o_The_Queue .  The  Front  :=  Node_N3nager  .New_Item; 

To  The_Queue.The_Back  To_The_Queue . The^Front ; 
TolThe_Queue . The_Fron t . The_I t em  : =  Fr om_Index . The_I tern ; 
To  Index  :=  To_The_Queue . The_Front ; 

Fronuindex  :=  From_Index.Next; 
while  From_lndex  /=  null  loop 

To_Index.Next  :=  Nodejianager .New_Item; 
To_Index.Next-The_Item  :=  From_Index.The_ltem; 
To_Index  :=  To_Index.Next ; 

From_Index  :=  Fronulndex.Next; 
To_The_Queue.The_Back  :=  To_Index; 
end  loop; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Copy; 

procedure  Clear  (The_Queue  :  in  out  Queue)  is 

^^^Node_Manager . Free ( The_Queue . The^Front ) ; 

The_Queue . The_Back  :=  null; 
end  Clear; 

procedure  Add  (The_Item  :  in  Item; 

To_The_Queue  :  in  out  Queue)  is 
Previous  ;  Structure;  ^  ^ 

Index  :  Structure  :=  To_The_Queue.The_Front; 
i>egin 

if  To_The_Queue.The_Front  =  null  then 

To_The_Queue.The_Front  ;=  NodeJManager .New^Item; 

To_The  Queue.The_Front .The_Item  :=  The_Item; 
To_ThelQueue .  The^Back  :  =  To_The_Queue .  The_Fron  t  ; 
else 

while  (Index  /=  null)  and  then 
( Prior i ty_0f (The_I tern)  <« 

Pr  ior i  ty_0  f  ( Index .  The_I  t  em ) )  loop 
Previous  Index; 

Index  :=  Index. Next; 
end  loop; 

if  Previous  =  null  then 

To„The_Queue.The_Front  :=  NodeJIanager.New_Item; 
To_The_Queue.The_Front.The_Item  The_Item; 


To_The_Queue . The_Fr on t . Next  : =  Index ; 
if  To_The__Queue  .The_Back  =  null  then 

To_The_Queue . The_Back  : =  To_The_Queue . The_Fr ont ; 
end  if; 

els if  Index  =  null  then 

To_The_Queue .  The_Back .  Next  :  =  Node_J«anager .  New_I tern; 
To_The_Queue . The_Back  ; =  To_The_Queue . The^Back . Next ; 
Tojrhe_Queue .The_Back.Th€_It€m  :=  The_Item; 

else 

Previous. Next  :=  Node^cinager .New_Item; 

Previous .Next .The_I tern  :=  The^Item; 

Previous. Next . Next  : =  Index ; 
end  if; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 

end  Add; 

procedure  Pop  (The^Queue  :  in  out  Queue)  is 
Temporary_Node  :  Structure; 
begin 

Temporary ^ode  : =  The_Queue . The_Front ; 

The_Queue . The_Front  : =  The_Queue . The_Front . Next ; 
Teirporary_Node .Next  :=  null; 

Node_Nanager .  Free  ( Temporary JJode ) ; 
if  The_Queue . The_Front  =  null  then 
The_Queue . The^Back  :=  null; 
end  if; 
exception 

when  Constraint_,Error  => 
raise  Underflow; 

end  Pop; 


procedure  Remove_Item  (FronuThe_Queue  ;  in  out  Queue; 

At_The_Position  ;  in  Positive)  is 

Count  :  Natural  :=  1; 

Previous  :  Structure ; 

Index  :  Structure  :=  From_The_Queue . The_Front ; 
begin 

while  Index  /=  null  loop 

if  Count  =  At_The_Position  then 
exit; 

else 

Coiint  :=  Count  +  1; 

Previous  :=  Index; 

Index  :=  Index. Next; 
end  if; 
end  loop; 

if  Index  =  null  then 

raise  Position_Error ; 
els if  Previous  =  null  then 

FronuThe_.Queue .  The_Front  :  =  Index .  Next  ; 

else 

Previous. Next  :=  Index. Next; 
end  if; 

if  From_The_Queue.The_Back  ®  Index  then 
From_The_Queue . The_Back  :=  Previous; 
end  if; 

Index . Next  ; =  nul 1 ; 

Node Jlanager . Free  ( Index)  ; 
end  Remo ve_I tern; 


—  modified  by  Tuan  Nguyen 

—  replacing  f\anctions  with  procedures 


procedure  ls_Equal  (Left 
Right 
Result 

begin 

Result  :=  Is^Equal (Lsf ' 
end  Is_Equal; 

procedure  Length^Of  (The_Queue 
Result 

begin 

Result  :=  Length_Of (The^Queue) ; 
end  Length_Of; 

procedure  Is^Empty  (The^Queue 
Result 

begin 

Result  ;=  Is_Eirpty(The_Queue)  ; 
end  Is^Enpty; 


procedure  Is^En^ty 


in  Queue; 
in  Queue ; 
out  Boolean)  is 


in  Queue ; 
out  Nat-ural)  is 


in  Queue ; 

out  Boolean)  is 


procedure  Front^Of  (The^Queue  :  in  Queue; 

Result  :  Item)  is 

begin 

Result  Front_Of (The_Queue) ; 

end  Front_0f; 

procedure  Position_0f  (The_Iteni  :  in  Item; 

In«The_Queue  ;  in  Queue; 

Result  :  out  Natural)  is 

^^^Result  Position^Of (The_Item,In_The_Queue) ; 

end  Position^Of; 
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end  of  modification 

function  Is_E(3ual  (Left  :  in  Queue; 

Right  :  in  Queue)  return  Boolean  is 
Left_Index  :  Structure  :=  Left .The_Front ; 

Right_Index  :  Structure  :=  Right . The_Front ; 
begin 

while  Left_Index  null  loop 

if  Left„Index.The_Itein  /=  Right_Index.The_Item  then 
return  False; 

else 

Left_Index  :=  Left_Index.Next; 

Right_Index  ;=  Right_Index.Next ; 
end  if; 
end  loop; 

return  (Right_Index  =  null) ; 
exception 

when  Constraint_Error  => 
return  False; 
end  Is_Equal; 

function  Length^Of  (The_Queue  :  in  Queue)  return  Natural  is 
Comt  :  Natural  :=  0; 

Index  :  Structure  :=  The_Queue .  The_Front ; 
begin 

while  Index  /=  null  loop 
Count  :=  Count  +  1; 

Index  :=  Index. Next; 
end  loop; 
return  Coomt; 
end  Length__0f; 

function  Is_Enpty  (The_Queue  :  in  Queue)  return  Boolean  is 
begin 

return  (The_Queue.The_Front  =  null); 
end  Is_Enpty; 


function  Front^Of  (The^CJueue  :  in  Queue)  return  Item  is 
begin 

return  The_Queue . The_Fr on t . The_I tem ; 
exception 

when  Cons  train t_Err  or  s=> 
raise  Underflow; 
end  Front^Of; 

function  Position_Of  (The_Item  ;  in  Item; 

In_The_jQueue  ;  in  Queue)  return  Natural  is 
Position  ;  Natural  ;=  1; 

Index  :  Structure  :=  In..The_Queue . The_Front ; 
begin 

while  Index  /=  null  loop 

if  Index ,  The_Item  =  The_Item  then 
return  Position; 

else 

Position  :=  Position  +  1; 

Index  ;=  Index, Next; 
end  if; 
end  loop; 
return  0; 
end  Position_Of; 

procedure  Iterate  (Over__The__Queue  ;  in  Queue)  is 

The_Iterator  :  Structure  :=  Over_The_Queue .The^Front ; 
Continue  :  Boolean ; 
begin 

while  not  (Ihe^Iterator  *  null)  loop 

Process (The_Iterator .The_Item,  Continue ) ; 
exit  when  not  Continue; 

The_Iterator  :=:  The_I ter ator .Next; 
end  loop; 
end  Iterate; 

end  Queue_Priori  ty_Balking_Sequential_UnboundedUManaged_I  tera  tor ; 
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QUEUE  PRIORITY  BALKING  SEQUENTIAL  UNBOUNDED  MANAGED  ITERATOR 

PSDL 


TYPE  Queue_PriorityL.Balk.ing_Seguential_Unbounded_Managed_Iterator 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TYPE , 

Priority  :  PRIVATE_TYPE, 

Priori ty_0£  :  FUNCTION [The_I tern  :  Item,  RETURN  :  Priority], 
func_-<-“  :  FUNCTIONfLeft  :  Priority,  Right  :  Priority,  RETURN  : 
Boolean] 

OPERATOR  Copy 
SPECIFICATION 
INPUT 

Fror\_The_Queue  :  Queue, 

To_The_Queue  :  Queue 
OUTPUT 

To_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Queue  :  Queue 
OUTPUT 

The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Add 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

To_The_Queue  :  Queue 
OUTPUT 

To_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position^Error 

END 

OPERATOR  Pop 
SPECIFICATION 
INPUT 

The_Queue  :  Queue 
OUTPUT 

The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Posit ion_Error 

END 

OPERATOR  Remove_Item 
SPECIFICATION 
INPUT 

From_The_Queue  :  Queue , 

At_The_Position  :  Positive 
OUTPUT 

From_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Posit ion_Error 

END 

OPERATOR  Is_Equal 
SPECIFICATION 
INPUT 


Left  :  Queue, 

Right  :  Queue 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Length_Of 

SPECIFICATION 

INPUT 

The_Queue  ;  Queue 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Is_Enpty 

SPECIFICATION 

INPUT 

The_Queue  :  Queue 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Front_Of 

SPECIFICATION 

INPUT 

The_Queue  :  Queue, 

Result  :  Item 
EXCEPTIONS 

Overflow.  Underflow,  Position^Error 

END 

OPERATOR  Position_Of 

SPECIFICATION 

INPUT 

The_Item  :  Item, 

In^The_Queue  :  Queue 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow,  Posit ion_Error 

END 

OPERATOR  Iterate 

SPECIFICATION 

GENERIC 

Process  ;  PROCEDURE [The_I tern  :  in It  :  Item],  Continue  ; 

Boolean] ] 

INPUT 

Over_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

END 

IMPLEMENTATION  ADA 

Queue„Priority_Balking_Sequential_Unbounded_Managed_Iterator 

END 


Out[t  : 
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QUEUE  PRIORITY  BALKING  SEQUENTIAL  UNBOUNDED  UNMANAGED  NONITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

type  Priority  is  limited  private; 

with  function  Priority_Of  {The_Item  :  in  Item)  return 

Priority; 

with  function  "<=“  {Left  :  in  Priority; 

Right  :  in  Priority)  return  Boolean; 

package 

Queue_Priority_Balking_Sequential_Unbounde<3LUninanagecUNoniterator  is 
type  Queue  is  limited  private; 


procedure  Copy 

<  Froict.The_Queue 

:  in 

Queue; 

To_The_Queue 

;  in  out 

Queue) ; 

procedure  Clear 

{The^Queue 

:  in  out 

Queue) ; 

procedure  Add 

(The^Item 

:  in 

Item; 

To_The_Queue 

:  in  out 

Queue) ; 

procedure  Pop 

(The_Queue 

;  in  out 

Queue) ; 

procedure  Remove_Item 

( Fr onuThe_Queue 

;  in  out 

Queue; 

At_The_Position  :  in 

Positive; 

modified  by  Tuan  Nguyen 
replacing  functions  with  procedures 

procedure  ls_Egual 

{Left  : 

in  {Jueue; 

Right  : 

in  Queue; 

Result  : 

out  Boolean) ; 

procedure  Length_Of 

{The^Queue 

in  Queue; 

Result  ; 

out  Natural) ; 

procedure  Is^Enpty 

{The^Queue  ; 

in  Queue; 

Result 

:  out  Boolean) ; 

procedure  Front_Of 

(The_Queue 

Result 

:  in  Queue ; 

:  Item)  ; 

procedure  PositionjOf 

{The_Item 

ItL,The_Queue 

Result 

;  in  I  tern; 

:  in  Queue ; 

:  out  Natural) ; 

end  of  modification 

function  Is^Equal 

{Left 

in  Queue; 

Right  : 

in  Queue)  return 

Boolean; 

function  Length^Of 

(The_Queue  : 

in  Queue)  return 

Natural; 

function  Is_Empty 

(The_Queue  ; 

in  Queue)  return 

Boolean; 

function  Front_Of 

( The^Queue  : 

in  C)ueue)  return 

Item; 

function  Position_Of 

(The_Item  : 

in  Item; 

In_The_Queue  : 

in  Queue)  return 

Natural ; 

Overflow  ;  exception; 
Underflow  :  exception; 
Position_Error  ;  exception; 


private 

type  Node; 

type  Structure  is  access  Node; 
type  Queue  is 
record 

The_Front  :  Structure; 

The_Back  :  Structure; 
end  record; 

end  Queue_Priority_Balking_Sequential_Unbo\inded_UnmanagecLNoniterator 
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QUEUE  PRIORITY  BALKING  SEQUENTIAL  UNBOUNDED  UNMANAGED  NONITERATOR 


ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

■Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  sxibdivision  (b)  (3)  {ii) 

—  of  the  rights  in  Technical  Data  and  Conputer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  s.  Parfet  Court,  Lakewood, 

—  Colorado  80227  {1-303-987-1874) 

package  body 

Queue_Pr  ior  i  ty_Ba  lking_Sequen  t  i  al_Unbounded_Unmanaged_JJon  1  ter  a  tor 

is 


type  Node  is 
record 

The_Item  :  Item; 

Next  :  Structure; 

end  record; 


procedure  Copy  (From_The_Queue  :  in  Queue; 

To_The_,Queue  :  in  out  Queue)  is 
Froituindex  :  Structure  :>=  FroiiuThe_Queue.The_Front; 
To_Index  :  Structure; 
begin 

if  Froitu.The_Queue .  The_Front  *  null  then 
To_The_Queue . The_Front  null; 

To__The_,Queue .  The_Back  :  ^  null  ; 


else 

To_The_Queue . The^Front  : = 

new  Node '  {The_Item  =>  FronL.Index.The_Item, 

Next  =>  null) ; 

To_The_Queue . The_Back  : =  To_The_Queue . The_Front ; 
To_Index  : =  To_The_Queue . The_Front ; 

Frott\_Index  :=  From_Index .  Next ; 
while  From_Index  /=  null  loop 

To_Index.Next  :=  new  Node '  (The_I tern  => 
From_Index .  The_Item, 

Next  =>  null) ; 


To_Index  : =  To_Index . Next ; 
From_Index  :=  From_Index.Next; 
To_The_Queue . The_Back  :=  To_Index; 
end  loop; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Copy; 


procedure  Clear  (The_Queue  :  in  out  Queue)  is 
begin 

The_Queue  ;=  Queue' (The_Front  =>  null, 
The_Back  =>  null) ; 

end  Clear; 


procedure  Add  (The_Item  :  in  Item; 

To_'lh.e_Queue  :  in  out  Queue)  is 
Previous  :  Structure; 

Index  :  Structure  To_The_Queue . The_Front ; 

begin 

if  To_The_Queue.The_Front  =  null  then 

To_The_Queue . The_Front  :=  new  Node  '  {The_I tern  =>  The_Item, 

Next  =>  null) ; 

To_The_Queue .  The_Back  :  =  To_The_Queue .  The_Front ; 

else 

while  (Index  /=  null)  and  then 
( Priori ty_Of{The_I tern)  <= 

Priori ty_Of ( Index . The_I tern) )  loop 
Previous  Index; 

Index  :=  Index. Next; 
end  loop; 

if  Previous  =  null  then 

To_'Ihe_Queue .  The_Front  :  = 

new  Node' (The^Item  =>  The_Item, 

Next  =>  Index) ; 

if  To_The_Queue . The_Back  =  null  then 

To jrhe_Queue .  The__Back  :  =  To_The_Queue .  The_Fr on  t ; 
end  if; 

els if  Index  =  null  then 

To_The_Queue.The_Back.Next  :=  new  Node '  {The_I tern  => 

Next  => 

To_The_Queue . The_Back  : =  To_The_Queue . The_Back . Next  ; 

else 

Previous  .Next  :=  new  Node  *  (The_I tern  =>  The_ltem, 

Next  =>  Index) ; 

end  if; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 

end  Add; 


The_Item, 
null) ; 


procedure  Pop  {The_Queue  ;  in  out  Queue)  is 
begin 

The_Queue .  The_Front  :  =  The_Queue .  The_Fr ont .  Next  ; 
if  The_Queue.The_Front  =  null  then 
The_Queue . The_Back  :=  null; 
end  if; 
exception 

when  Constraint_Error  ==> 
raise  Underflow; 

end  Pop; 

procedure  Remove_Item  { From_The_Queue  :  in  out  Queue; 

At_The_Position  :  in  Positive)  is 
Coimt  :  Natural  :=  1; 

Previous  :  Structure; 

Index  ;  Structure  :=  From_Tbe_Queue  .The_Front ; 
begin 

while  Index  /=  null  loop 

if  Covint  =  At_The_Position  then 
exit; 

else 

Count  :=  Count  +  1; 

Previous  :=  Index; 

Index  :=  Index. Next; 
end  if; 
end  loop; 

if  Index  =  null  then 

raise  Position_Error ; 
els if  Previous  =  null  then 

From_The_Queue ,  The_Fr ont  ;  =  Index .  Next ; 

else 

Previous . Next  : =  Index . Next ; 
end  if; 

if  FroiruThe_Queue  - The_Back  =  Index  then 
From_The_Queue . The_Back  : =  Previous ; 
end  if; 

end  R€move_Itein; 

modified  by  Tuan  Nguyen 
replacing  fimctions  with  procedures 

procedure  Is_Equal  (Left  : 

Right  ; 

Result  : 

begin 

Result  :=  Is_Egual (Left, Right) ; 
end  Is_Equal; 

procedure  Length_0f  (The_Queue  : 

Result  : 

begin 

Result  :=  Length_0f (The_Queue) ; 
end  Length_Of; 

procedure  Is_En?)ty  (The_Queue  : 

Result  ; 

begin 

Result  :=  Is_Einpty  (The_Queue)  ; 
end  Is_Empty; 

procedure  Front_0f  (The_Queue  : 

Result  : 

begin 

Result  :=  Front_Of (The_Queue) ; 
end  Front_0f; 

procedure  Position_0f  (The_Item  ; 

In_The_Queue  ; 

Result  : 

begin 

Result  :  Posit ion_Of  ( The_I t em ,  In_The_Queue ) ; 
end  Position_Of; 

end  of  modification 

function  Is_Egual  (Left  ;  in  Queue; 

Right  :  in  Queue)  return  Boolean  is 
Left_Index  :  Structure  :=  Lef t .The_Front; 

Right_lndex  :  Structure  :=  Right .The_Fr ont; 
begin 

while  Left_Index  /=  null  loop 

if  Left_Index.The_Item  /=  Right_Index,The_Item  then 
return  False; 

else 

Left_Index  :=  Lef t_Index. Next ; 

Right_lndex  :=  Right_Index.Next ; 
end  if; 
end  loop; 

return  (Right_Index  =  null) ; 
exception 

when  Cons t rain t_Err or  => 
return  False; 
end  Is_Equal; 

function  Length^Of  (The_Queue  :  in  Queue)  return  Natural  is 
Covint  :  Natural  :=  0; 

Index  :  Structure  :=  The_Queue . The_Fr ont ; 
begin 


in  Queue; 
in  Queue; 
out  Boolean)  is 


in  Queue; 

out  Natural)  is* 


in  Queue ; 

out  Boolean)  is 


in  Queue; 
Item)  is 


in  Item; 

in  Queue; 

out  Natural)  is 
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while  Index  /=  null  loop 
Count  :=  Count  +  1; 

Index  :*  Index. Next ; 
end  loop; 
return  Count; 
end  Length>.Of; 

f Vine t ion  Is_Ei)npty  (The_Queue  :  in  Queue) 
begin 

return  (The__Queue.The_Front  =  null); 
end  Is_Ertpty; 

function  Front_Of  (The_Queue  :  in  Queue) 
begin 

return  The_Queue . The_Front .  The^I tern; 
exception 

when  Constraint^Error  => 
raise  Underflow; 
end  Front_Of; 


return  Boolean  is 


return  Item  is 


fvinction  Position_Of  {The_Item  ;  in  Item; 

In_The_Queue  :  in  Queue)  return  Natural  is 
Position  :  Natural  :=  1; 

Index  :  Structure  :=  ln_'Ihe_Queue . The_Front ; 
begin 

while  Index  !-  null  loop 

if  Index. The_I tern  =  The_Item  then 
return  Position; 

else 

Position  ;=  Position  +  1; 

Index  :=  Index. Next ; 
end  if; 
end  loop; 
return  0; 
end  Position„Of; 

end  Queue_Pr  iori  ty_Balking_Sequential_Unbounded_Unmanaged_Noni  terator ; 
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QUEUE  PRIORITY  BALKING  SEQUENTIAL  UNBOUNDED  UNMANAGED  NONITERATOR 


PSDL 


TYPE  Queue  priority__Balking_Sequential_Uiibounde(i_UnmanagecLJJoniterator 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE^TYPE, 

Priority  :  PRIVATE_TyPE, 

Priority_Of  ;  FUNCTION  [The_I tern  :  Item,  RETURN  :  Priority] , 

:  FUNCTION  [Left  :  Priority,  Right  :  Priority,  RETURN  : 

Boolean] 

OPERATOR  Copy 
SPECIFICATION 
INPUT 

From_The_Queue  :  Queue , 

To_The_Queue  :  Queue 
OUTPUT 

To_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Queue  :  Queue 
OUTPUT 

The_Queue  ;  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Posit ion_Error 

END 

OPERATOR  Add 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

To_The_Queue  :  Queue 
OUTPUT 

To_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Pop 
SPECIFICATION 
INPUT 

The_Queue  :  Queue 
OUTPUT 

The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Remove_Item 
SPECIFICATION 
INPUT 

FronL.The_Queue  :  Queue , 

At_'nie_Position  :  Positive 
OUTPUT 

ProirL_The_Queue  :  Queue 
EXCEPTIONS 


Overflow,  Underflow,  Position_Error 

END 

OPERATOR  IS_Equal 

SPECIFICATION 

INPUT 

Left  :  Queue, 

Right  :  Queue 
OUTPUT 

Result  ;  Boolean 
EXCEPTIONS 

Overflow,  Underflow,  Position^Error 

END 

OPERATOR  Length_Of 

SPECIFICATION 

INPUT 

“Ihe^Queue  :  Queue 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Is_Ert?)ty 

SPECIFICATION 

INPUT 

The_Queue  :  Queue 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Front_Of 

SPECIFICATION 

INPUT 

The_Queue  ;  Queue , 

Result  :  Item 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

OPERATOR  Position_Of 

SPECIFICATION 

INPUT 

The_Item  ;  Item, 

InL.The_Queue  ;  Queue 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow,  Position_Error 

END 

END 

IMPLEMENTATION  ADA 

Queue_Pr  i  or  i  ty_Bal  king_Sequen  t  ial_Unbounded_Unmanaged_Noni  ter  a  t  or 

END 
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QUEUE  PRIORITY  NONBALKING  SEQUENTIAL  UNBOUNDED  UNMANAGED  NONITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

type  Priority  is  limited  private; 

with  function  Priori ty_Of  (The^Item  :  in  Item)  return 
Priority; 

with  function  "<="  (Left  :  in  Priority; 

Right  :  in  Priority)  return  Boolean; 

package 

Queue_Pr  ior  i  ty_JJohba  lking_Sec3uent  ial_UnboundecL.UninanagedJNoni  t  er  a  tor 

is 


type  Queue  is  limited  private; 

procedure  Copy  ( From_The_Queue  ;  in  Queue; 

To_The_Queue  ;  in  out  Queue) ; 
procedure  Clear  (The_Queue  ;  in  out  Queue) ; 

procedure  Add  (The_Item  :  in  I tern; 

To_The_Queue  :  in  out  Queue) ; 
procedure  Pop  (The_Queue  :  in  out  Queue) ; 

—  modified  by  Tuan  Nguyen 

replacing  functions  with  procedures 


procedure  Is_Equal 
procedure  Length-Of 


(Left 

Right 

Result 

(The_Queue 


in  Queue; 
in  Queue; 
out  Boolean) ; 
in  Queue; 


Result 

procedure  Is^Empty  {The_Queue 

Result 

procedure  Front_Of  {The_Queue 

Result 


end  of  modification 


out  Natural) ; 
in  Queue; 
out  Boolean) ; 
in  Queue; 
Item)  ; 


f line  t  ion  Is^Equal  (Left 
Right 

function  Length_Of  (The_Queue 
function  Is^Enpty  (The_Queue 
function  Front_Of  (The_Queue 


in  Queue; 
in  Queue) 
in  Queue) 
in  Queue) 
in  Queue) 


return  Boolean ; 
return  Natural; 
return  Boolean; 
return  Item; 


Overflow  :  exception; 
Underflow  ;  exception; 


private 

type  Node; 

type  Structure  is  access  Node; 
type  Queue  is 
record 

The_Front  :  Structure; 

The_Back  :  Structure; 
end  record; 

end 

Queue_Priori  ty _Nonbalking_Sequential_Unbounded_UnmanagedJNoni  terator ; 
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QUEUE  PRIORITY  NONBALKING  SEQUENTIAL  UNBOUNDED  UNMANAGED  NONITERATOR 

ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 


end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 

end  Add; 


"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  sxibdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Conputer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 


package  body  ^  • 

Queue_Pr  ior  i  ty^Nonba  lking_Seguent  ial_Unbounde<3LtJnmanaged_Noni  ter  a  t  or 


type  Node  is 
record 

The_Item  ;  Item; 

Next  :  Structure; 
end  record; 


procedure  Copy  (FronL_The_Queue  :  in  Queue; 

To_The_Queue  :  in  out  Queue)  is 
Fron\_Index  :  Structure  :=  From_The_Queue . The_Front ; 
To_Index  :  Structure; 
begin 

if  FrorruThe_Queue.The_Front  »  null  then 
To_The_Queue.The_Front  null; 

To_The_Queue •  The_Back  :=  null; 

else 


To_The_Queue . The_Front  : = 

new  Node'  (The_Item  =>  FroiiuIndex.The_Item, 

Next  =>  null); 

To_The_Queue . The_Back  : =  To_The_Queue . The_Front ; 
To_lndex  :=  To jrhe_Queue . The_Fr ont ; 

Froin_Index  :=  Fron\_Index.Next; 
while  Frorruindex  /-  null  loop 

To_Index.Next  :=  new  Node’  {The_Item  => 
Fronulndex .  The^I  tern. 

Next  =>  null ) ; 


To^Index  ; =  To_Index . Next ; 
Fronulndex  :=  Froitv_Index.Next ; 
To_The_Queue . The_Back  :=  To^Index; 
end  loop; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Copy; 


procedure  Clear  (The_Queue  :  in  out  Queue)  is 
begin 

The_Queue  :=  Queue’ {The_Front  =>  null, 
The_Back  =>  null ) ; 

end  Clear; 


procedure  Add  (The_Item  :  in  Item; 

To_The_Queue  :  in  out  Queue)  is 
Previous  :  Structure ; 

Index  :  Structure  :=  To_The_Queue . The_Front ; 
begin 

if  To_The_Queue.The_Front  =  null  then 

To_The_Queue . The_Front  new  Node’ (Thc_I tern  =>  The_Itein, 

Next  =>  null) ; 

To_The_Queue.The_Back  :=  To_’rhe_Queue . The_Front ; 

else 

while  (Index  /-  null)  eind  then 
( Priori ty_Of (The_Item)  <= 

Priori ty_Of  ( Index ,  The_I tern) )  loop 
Previous  :=  Index; 

Index  :  =  Index .  Next ; 
end  loop; 

if  Previous  =  null  then 

To_The_Queue .  The^Front  :  = 

new  Node’  (The^Item  =>  The_Itein, 

Next  ->  Index)  ; 
if  To_The_Queue .  The_Back  =  null  then 

To_The_Queue . The_Back  : =  To_The_Queue . The_Front ; 
end  if; 

elsif  Index  =  null  then 

To_The_Queue.The_Back.Next  :=  new  Node* (The_I tern  => 


The_Item, 


Next  => 


null) ; 


To_The_Queue .  The_Back  :  =  To_The_Queue .  The_Baek .  Next ; 

Previous  .Next  :=  new  Node*  (The_Item  =>  The_Item, 
Next  =>  Index) ; 


end  if; 


procedure  Pop  (The_Queue  :  in  out  Queue)  is 
begin 

The_Queue . The_Fr on t  : =  The_Queue . The_Fr on t . Nex t ; 
if  The_Queue . The_Front  =  null  then 
The_Queue.The_Back  :=  null; 
end  if; 
exception 

when  Constraint_Error  => 
raise  Underflow; 

end  Pop; 


—  modified  by  Tuan  Nguyen 

—  replacing  functions  with  procedures 


procedure  Is_Equal  (Left  :  in  Queue; 

Right  :  in  Queue; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is_Equal (Left, Right ) ; 
end  Is_Equal; 


procedure  Length^Of  (The_Queue 
Result 

begin 

Result  Length_Of (The_Queue) ; 
end  Length_0f; 

procedure  Is_Empty  (The_Queue 

Result 

begin 

Result  Is_En55ty  (The_Queue)  ; 
end  Is_Eirpty; 

procedure  Front_Of  (The_Queue 

Result 

begin 

Result  :=  Front_Of (The_Queue) ; 
end  Front_Of; 


in  Queue; 
out  Natural)  is 


in  Queue; 

out  Boolean)  is 


in  Queue; 
Item)  is 


—  end  of  modification 

fxjnction  Is_E<3ual  (Left  :  in  Queue; 

Right  ;  in  Queue)  return  Boolean  is 
Left_Index  :  Structure  :=  Left. The_Fr ont; 

Right_Index  :  Structure  :=  Right . The_Front ; 
begin 

while  Left_Index  /=  null  loop 

if  Left_Index.The_Item  /=  High t_Index.The_I tern  then 
return  False; 

else 

Left_Index  :=  Left_Index.Next; 

Right_Index  ;=  Right_Index.Next ; 
end  if; 
end  loop; 

return  (Right_Index  =  null)  ; 
exception 

when  Constraint_Error  => 
return  False; 
end  Is_Equal; 

function  Length_0f  (The_Queue  ;  in  Queue)  return  Natural  is 
Count  :  Natural  :=  0; 

Index  :  Structure  ;=  The_Queue . The_Front ; 
begin 

while  Index  /=  null  loop 
Count  :=  Count  +  1; 
index  :=  Index. Next; 
end  loop; 
return  Count; 
end  Length_Of; 

fxinction  Is_Eirpty  (The_Queue  :  in  Queue)  return  Boolean  is 
begin 

return  (The_Queue.The_Front  =  null) ; 
end  Is_Eir5>ty; 

function  Front_0f  (The_Queue  :  in  Queue)  return  Item  is 
begin 

return  The_Queue . The_Pr on t .  The_I t em ; 
exception 

when  Constraint_Error  «> 
raise  Underflow; 
end  Front_0f; 


Queue_Pr  ior  i  ty_Nonbalking_Sequent  i  al_UnboundecL.Unmanaged_Noni  tera  tor 
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QUEUE  PRIORITY  NONBALKING  SEQUENTIAL  UNBOUNDED  UNMANAGED  NONITERATOR 

PSDL 


TYPE 

Queue_Pr  ior  i  tyJNonbalking_Sequen  t  i  al_Unbounded_UnmanagedLNon  i  ter  a  tor 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TYPE, 

Priority  :  PRIVATE_TYPE, 

Priori ty_Of  :  FUNCTION [The„Item  :  Item,  RETURN  :  Priority], 
func_'’<="  :  FUNCTION[Left  :  Priority,  Right  :  Priority,  RETURN  ! 
Boolean] 

OPERATOR  Copy 
SPECIFICATION 
INPUT 

FronuThe_Queue  :  Queue, 

To_The_Queue  ;  Queue 
OUTPUT 

To_The_Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Queue  ;  Queue 
OUTPUT 

The^Queue  :  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Add 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

To_The_Queue  :  Queue 
OUTPUT 

To_The_Queue  ;  Queue 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Pop 
SPECIFICATION 
INPUT 

The^Queue  :  Queue 
OUTPUT 

The_Queue  :  Queue 
EXCEPTIONS 


Overflow,  Underflow 

END 

OPERATOR  Is_Egual 

SPECIFICATION 

INPUT 

Left  :  Queue, 

Right  :  Queue 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Length_Of 

SPECIFICATION 

INPUT 

The_Queue  :  Queue 
OUTPUT 

Result  ;  Natural 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Is_En5>ty 

SPECIFICATION 

INPUT 

The_Queue  ;  Queue 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Front^Of 

SPECIFICATION 

INPUT 

The_Queue  ;  Queue , 

Result  :  Item 
EXCEPTIONS 

Overflow,  Underflow 

END 

END 

IMPLEMENTATION  ADA 

Queue_„Priority_Nonbalking_Sequential„Unbo\anded_UnmanageoLNoniterator 

END 
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RING  SEQUENTIAL  BOUNDED  MANAGED  ITERATOR 
ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

package  Ring_Sequential_BoundecL>lanaged^Iterator  is 

type  Ring (The_Size  :  Positive)  is  limited  private; 
type  Direction  is  (Forward,  Backward) ; 


procedure  Copy 
Ring; 

Ring)  ; 

procedure  Clear 
Ring) ; 

procedure  Insert 
Item; 

Ring) ; 

procedure  Pop 
Ring) ; 

procedure  Rotate 
Ring  ; 

Direction) ; 

procedure  Mark 
Ring) ; 

procedure  Rotate_To^Mark 
Ring) ; 

—  modified  by  Tuan  Nguyen 

—  10  Jeinuary  1996 

—  adding  procedures  to  rep! 


( From_The_Ring 

in 

To_The_Ring 

in 

out 

(The_Ring 

in 

out 

{The_Item 

in 

IruThe_Ring 

in 

out 

{The_Ring 

in 

out 

{The_Ring 

in 

out 

In_The_Direction 

in 

{The_Ring 

in 

out 

(The_Ring 

in 

out 

functions 


procedure  Is_Equal  (Left  :  in  Ring; 

Right  :  in  Ring; 

Result  :  out  Boolean) ; 

procedure  Extent^Of  (The_Ring  :  in  Ring; 

Result  :  out  Natural) ; 

procedure  Is_Eiipty  (The_Ring  :  in  Ring; 

Result  :  out  Boolean)  ; 


procedure  Top_Of  (The_Ring  :  in  Ring; 

Result  :  out  Item) ; 
procedure  At_Mark  (The_Ring  :  in  Ring; 

Result  :  out  Boolean) ; 

—  end  of  modification 

function  Is_Equal  (Left  :  in  Ring; 

Right  :  in  Ring)  return 

Booleami; 

function  Extent_Of  (The_Ring  :  in  Ring)  return 
Natural ; 

function  Is_Empty  (The_Ring  :  in  Ring)  return 
Boolean; 

function  Top_Of  (The_Ring  ;  in  Ring)  return 
I  tern; 

function  At_Mark  (The_Ring  ;  in  Ring)  return 
Boolean; 

generic 

with  procedure  Process  (The_Item  :  in  I tern; 

Continue  :  out 

Boolean) ; 

procedure  Iterate  (Over_The_Ring  :  in  Ring) ; 

Overflow  :  exception; 

Underflow  :  exception; 

Rotate_Error  :  exception; 

private 

type  Items  is  array (Positive  range  <>)  of  Item; 
type  Ring{The_Size  :  Positive)  is 
record 

The_Top  :  Natural  :=  0; 

The_Back  :  Natural  :=  0; 

The_Mark  :  Natural  :=  0; 

The_Items  :  Items (1  ..  The^Size) ; 

end  record; 

end  Ring_Sequential_BoundecLManaged_Iterator ; 
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RING  SEQUENTIAL  BOUNDED  MANAGED  ITERATOR 
ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady 
Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

—  "Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3) 
(ii) 

—  of  the  rights  in  Technical  Data  cuid  Conputer 

—  Software  Clause  of  FAR  52.227~7013.  Mcuiufacturer : 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body  Ring_Sequential_BoundecLManaged_Iterator 
is 

procedure  Copy  (FronuThe^Ring  :  in  Ring; 

To_The_Ring  :  in  out  Ring)  is 

begin 

if  From_The_Ring.The_Back  > 
To_The_Ring.The_Size  then 

raise  Overflow; 

elsif  Fr on\_The_Ring .  The^Back  =  0  then 
To_The_Ring . The_Top  : =  0 ; 

To_The_Ring .  The_Back  ;=  0; 

To_The_Ring . The JMark  :=  0; 

else 

To_The_Ring . The_I terns (1  ♦ . 
Froiiu.The_Jling.The_Back)  :  = 

Fr onuThe^Ring .  The_I  terns  (1  . . 
Froin_The_Ring.The_Back) ; 

To_The_Ring.The_Top  ;= 

Fr  oin_The_Ring .  The_Top ; 

To_The_Ring.The_Back  := 

Froir\_The_Ring .  The^Back  ; 

To_The_Ring.The_Nark  := 

Frortu'Kie^Ring .  The JMark ; 
end  if; 
end  Copy; 

procedure  Clear  (The_Ring  :  in  out  Ring)  is 
begin 

The_Ring . The_Top  ;=  0; 

The_Ring . The_Back  :=  0; 

The_Ring. The JMark  :=  0; 
end  Clear; 


if  The_Ring.The_Top  =  The_Ring  -  Thenar  k 

then 

The_Ring.The^ark  :=  1; 
end  if; 

The_Ring . The_Top  :=  1; 

else 

if  The_Ring .  The  JMark  >  The_Ring .  The_Top 

then 

The_Ring , The^Mark  : = 

The_Ring .  The  JMark  -  1; 

end  if; 
end  if; 
end  if; 
end  Pop; 

procedure  Rotate  (The_,Ring  :  in  out  Ring; 

In_The_Direction  ;  in 

Direction)  is 
begin 

if  The_Ring . The_Back  =  0  then 
raise  Rotate_Error; 
elsif  In_The_Direction  =  Forward  then 

The_Ring.The_Top  :=  Th€_Ring . The_Top  +  1; 
if  The_Ring.The_Top  >  The^Ring . The_Back 

then 

The_Ring . The^Top  : =  1 ; 
end  if; 

else 

The_Ring .The_Top  The^Ring . The_Top  -  1; 
if  The_Ring . The_Top  =  0  then 

TheJRing .  The_Top  ;  =  The_Ring .  The_Back ; 
end  if; 
end  if; 
end  Rotate; 

procedure  Mark  (The_Ring  :  in  out  Ring)  is 
begin 

The_Ring . The_Mark  : =  The^Ring , The_Top ; 
end  Mark; 

procedure  Rotate_To_Mark  (The_Ring  :  in  out  Ring) 
is 

begin 

The_Ring .  The_Top  :=  The_Ring .  The_Mark ; 
end  Rotate_To_Mark; 

—  modified  by  Tuan  Nguyen 

—  10  January  1996 

—  adding  procedures  to  replace  functions 


procedure  Insert  (The_Itein  :  in  I  tern; 

In_TheJRing  :  in  out  Ring)  is 

begin 

if  In_The_Ring , The JBack  =:  In_The_Ring.The_Size 

then 

raise  Overflow; 

elsif  In_The_Ring.The_Back  =  0  then 
In_The_Ring . The_Top  :=  1; 

In_The_Ring .  The_Back  :=  1; 

In^The_Ring ,  The_^rk  :=  1; 

In_The_Ring .  The_I  terns  ( 1 )  ;  =  The_I  tern ; 

else 

In^The__Ring .  The_I  teins 

( (In_The_Ring.The_Top  +1) 

( InJTheJRing .  The_Back  +  1 ) )  :  = 

In_The_Ring .  The_I  terns  ( In_The_Ring .  TheJTop 


In_The_Ring.The„Back)  ,- 

In_The_Ring .  The_I  terns  ( In_The_Ring .  The_Top ) 

:=  The_Item; 

In_The_Ring .  The_Back  :  = 

In_The_Ring . The_Back  +  1; 

if  In_The_Ring.  The  JMark  >= 

In_The_Ring .  The_Top  then 

In_The_Ring .  The_Mark  :  = 

In_The_Ring.  The  JMark  +  1; 
end  if; 
end  if; 
end  Insert; 


procedure  Is_Equal  (Left  :  in  Ring; 

Right  :  in  Ring; 

Result  ;  out  Boolean)  is 

begin 

Result  ;=  Is_Equal (Left, Right) ; 
end  Is_Egual; 

procedure  Extent_Of  (The_Ring  :  in  Ring; 

Result  ;  out  Natural)  is 

begin 

Result  :=  Extent_Of {The_Ring) ; 
end  Extent_Of; 

procedure  Is_Ertpty  (The_Ring  :  in  Ring; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is_Enpty (The_Ring) ; 
end  Is_Eirpty; 

procedure  Top_Of  (The^Ring  :  in  Ring; 

Result  :  out  Item)  is 

begin 

Result  : =  Top_0 f ( The_Ring ) ; 
end  Top_Of; 

procedure  At  JMark  (The_Ring  ;  in  Ring; 

Result  :  out  Boolean)  is 

begin 

Resul t  : =  A t_Mar k ( The^Ring ) ; 
end  AtJIark; 


procedure  Pop(The_Ring  :  in  out  Ring)  is 
begin 

if  The_Ring.The_^ack  =  0  then 
raise  Underflow; 

elsif  The_Ring . The_Back  =  1  then 
The_Ring . The_Top  : =  0 ; 

The_Ring.The_Back  :=  0; 

The_Ring.  The  JMark  :=  0; 

else 

The^Ring .  The_I  terns  ( The_Ring .  The_,Top  . . 
(The_Ring . The_Back  -  1 ) )  : = 

The_Ring .  The_I  terns  ( { The_Ring .  The_Top  +  1 ) 
The_Ring.The_Back) ; 

The_Ring.The_Back  :=  The_Ring . The_Back  -  1; 
if  TheJR.ing.The_Top  >  The_Ring . The_Back 

then 


—  end  of  modification 

function  Is_Equal  (Left  :  in  Ring; 

Right  :  in  Ring)  return  Boolean 
is 

Left^Index  :  Natural  :=  Lef t .The_Top; 

Right_Index  :  Natural  :=  Right . The_Top ; 
begin 

if  Left.The_Back  /=  Right . The^Back  then 
return  False; 

elsif  Left.The_Items(Left_Index)  /= 

Right . The_I terns ( Right_Index)  then 
return  False; 

elsif  (Left .Thejlark  =  Left_Index)  and  then 
(Right .The_Mark  /=  Right_Index)  then 
return  False; 

else 
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Left_Index  :=  Left_Index  +  1; 
if  Left_Index  >  Lef  t  .Th.e_Back  then 
Left_Index  1; 
end  if; 

Right_Index  :=  Right_Index  +  1; 
if  Right_Index  >  Right. The_Back  then 
Right_lndex  :=  1; 
end  if; 

while  Left^lndex  /=  Left.The_Top  loop 
if  Left.The_Iteins(Left_Index)  /= 

Right .  The_Iteins  ( Right_Index)  then 
return  False; 

elsif  (Left .The Jlark  =  Left^Index)  and 


then 

then 


{ Right. The^Mark  /=  Right^Index) 
return  False; 

else 

Left_Index  Left_Index  +  1; 
if  Left^Index  >  Left .The_Back  then 
Left^Index  :=  1; 
end  if; 

Right^Index  :=  Right_Index  +  1; 
if  Right_Index  >  Right .The_Back 


then 


Right_Index  :=  1; 
end  if; 
end  if; 
end  loop; 

return  (Right_Index  =  Right .The_Top) ; 


end  if; 
exception 

when  Constraint^Error  => 

return  (Left. The_Top  =  Right . The_Top ) ; 
end  Is_Equal; 


function  Extent^Of  {The_Ring  :  in  Ring)  return 
Natural  is 
begin 

return  The_Ring-The_Back; 
end  Extent^Of; 


function  Is_EBpty  (The_Ring  ;  in  Ring)  return 
Boolean  is 
begin 

return  (The_Ring.The_Back  =  0); 
end  Is^Enpty; 

function  Top_Of  (The^Ring  :  in  Ring)  return  Item  is 
begin 

return  The^Ring .  The^Items  ( The_Ring . The_Top )  ; 
exception 

when  Constraint^Error  => 
raise  Underflow; 
end  Top_Of; 

function  At_Mark  (The^Ring  :  in  Ring)  return 
Boolean  is 
begin 

return  (The_Ring,The_Top  =  The_Ring.The_Mark)  ; 
end  At_Na3Ck; 

procedure  Iterate  (Over_The_Ring  :  in  Ring)  is 
Continue  :  Boolean  :=  True; 
begin 

for  The_Iterator  in  Over_The_Ring.The_Top  .. 

Over_The_Ring , The_Back  loop 

Process  {Over_The_Ring.The_I terns  (The_Iterator ) , 

Continue) ; 

exit  when  not  Continue; 
end  loop; 
if  Continue  then 

for  The_Iterator  in  1  . . 

Over_The_Ring . The_Top  -  1  loop 

Process  (Over_The_Ring.The_I terns  (The_Iterator) , 

Continue) ; 

exit  when  not  Continue; 
end  loop; 
end  if; 
end  Iterate; 

end  Ring_Se<3uential_Bound€d_Nanaged_Iterator ; 
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RING  SEQUENTIAL  BOUNDED  MANAGED  ITERATOR 

PSDL 


TYPE  Ring__Sequential_BoundedJIanagec3_Iterator 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

FronuThe^Ring  :  Ring, 

To_The_Ring  :  Ring 
OUTPUT 

To_The_Ring  ;  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate^Error 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The^Ring  :  Ring 
OUTPUT 

The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Insert 
SPECIFICATION 
INPUT 

The^Item  :  Item, 

In__The_Ring  :  Ring 
OUTPUT 

In_The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Pop 
SPECIFICATION 
INPUT 

The_,Ring  :  Ring 
OUTPUT 

The^Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Rotate 
SPECIFICATION 
INPUT 

The_Ring  :  Ring , 

In_The_Direction  ;  Direction 
OUTPUT 

The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Mark 
SPECIFICATION 
INPUT 

The_Ring  ;  Ring 
OUTPUT 

The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Rotate_To_Mark 
SPECIFICATION 
INPUT 

The_Ring  :  Ring 
OUTPUT 


The^Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  IS^Equal 

SPECIFICATION 

INPUT 

Left  :  Ring, 

Right  ;  Ring 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Extent_Of 

SPECIFICATION 

INPUT 

The_Ring  :  Ring 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Is_Eit?3ty 

SPECIFICATION 

INPUT 

The_Ring  ;  Ring 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Top_Of 

SPECIFICATION 

INPUT 

Ihe^Ring  :  Ring 
OUTPUT 

Result  :  Item 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  At_Mark 

SPECIFICATION 

INPUT 

The_Ring  :  Ring 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Iterate 

SPECIFICATION 

GENERIC 

Process  :  PROCEDURE  [The_I tern  :  in[t  :  Item] 
Continue  :  out  It  :  Boolean]] 

INPUT 

Over_The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

END 

IMPLEMENTATION  ADA 

Ring_Sequential_BoundedLManaged^Iterator 

END 
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RING  SEQUENTIAL  BOUNDED  MANAGED  NONITERATOR 
ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

package  Ring_Sequential_Bounded^anaged_Noniterator  is 

type  Ring{The_Size  :  Positive)  is  limited  private; 
type  Direction  is  {Forward,  Backward) ; 


procedure  Copy 
Ring; 

Ring)  ; 

procedure  Clear 
Ring) ; 

procedure  Insert 
Item; 

Ring)  ; 

procedure  Pop 
Ring) ; 

procedure  Rotate 
Ring; 

Direction) ; 

procedure  Mark 
Ring) ; 

procedure  Rotate_To_JIark 
Ring) ; 


{ Fr  om_The_Ring 
To_The_Ring 
(The_Ring 
{The_Item 
In_The_Ring 
(The_Ring 
(The_Ring 
In_The_Dir ec  t ion 
(The^Ring 
(The_Ring 


in 

in  out 
in  out 
in 

in  out 
in  out 
in  out 
in 

in  out 
in  out 


function  Is_Equal  (Left  :  in  Ring; 

Right  :  in  Ring)  return 

Boolean; 

function  Extent_Of  (The^Ring  :  in  Ring)  return 
Natural ; 

function  Is_En?>ty  (The_Ring  :  in  Ring)  return 
Boolean; 

function  Top_Of  (The_Ring  :  in  Ring)  return 
Item; 

function  Atjlark  {The_Ring  :  in  Ring)  return 
Boolean; 

Overflow  :  exception; 

Underflow  ;  exception; 

Rotate_Error  ;  exception; 

private 

type  Items  is  array (Positive  range  <>}  of  I tern; 
type  Ring(The_Siz€  :  Positive)  is 
record 

The_Top  ;  Natural  :=  0; 

The_Back  ;  Natural  :=  0; 

TheJIark  :  Natural  :=  0; 

The_Items  :  Items (1  ..  The^Size) ; 

end  record; 

end  Ring_Sequential_Bounded^Jlanaged_Noniterator ; 
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RING  SEQUENTIAL  BOUNDED  MANAGED  NONITERATOR 
ADA  IMPLEMENTATION 


—  (C>  Copyright  1986,  1987,  1988,  1989,  1990  Grady 
Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

“Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  s\jbject  to 

—  restrictions  as  set  forth  in  stibdivision  (b)  (3) 
(ii) 

—  of  the  rights  in  Technical  Data  and  Conputer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer; 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 


package  body 

Ring_Sequential_Bounded_ManagedJJon  iterator  is 

procedure  Copy  (FronuThe_Ring  :  in  Ring; 

To_The_Ring  :  in  out  Ring)  is 

begin 

if  Froin_The_Ring .  The_Back  > 
To_The_Ring.The_Size  then 
raise  Overflow; 

elsif  FronL_The_Ring .  The_Back  =  0  then 
To_The_Ring .  The^Top  :=  0; 

To_The_Ring .  The_Back  ;  =  0  ; 
To_The_Ring.The_Mark  :=  0; 

else 

To_The_Ring .  The_I  terns  (1  . . 

Fr on\_The_Ring .  The^Back }  :  = 

Froit\_The_Ring .  The_I  terns  (1  . , 
FronL,The_Ring .  The^Back) ; 

To_The_Ring .  The_Top  :  = 

FroiiuThe_Ring .  The_Top  ; 

To_The_Ring .  The_Back  :  = 

FronuTlie—Ring .  The_Back  ; 

To_The_Ring .  The^Mark  :  = 

FronL.The_Ring .  The.,Ma  ; 
end  if; 
end  Copy; 

procedure  Clear  (The_Ring  ;  in  out  Ring)  is 
begin 

The_Jling .  The_Top  ;  =  0 ; 

The_Ring.The_Back  :=  0; 

The_Ring.The_Mark  :=  0; 
end  Clear; 


if  The_Ring . The jTop  «  The_Ring.The_Mark 

then 

The_Ring . The Jdark  : =  1 ; 
end  if; 

The_Ring . The_Top  : =  1 ; 

else 

if  The_Ring-The_Mark  >  The^Ring.TheJTop 

then 

The_Ring . The Jlark  ;  = 

The_Ring . The_Mark  -  1; 

end  if; 
end  if; 
end  if; 
end  Pop; 

procedure  Rotate  (The_Ring  :  in  out  Ring; 

In_The_Direction  :  in 

Direction)  is 
begin 

if  The_Ring . The_Back  =  0  then 
raise  Rotate_Error ; 
elsif  Injrhe_Direction  =  Forward  then 

The_Ring . The_Top  :=  The_Ring . The_Top  +  1; 
if  The_Ring . The_Top  >  The_Ring.The_Back 

then 

The_Ring . The_Top  : =  1 ; 
end  if; 

else 

The_Ring ,  The_Top  :=  The_Ring .  The_Top  -  1; 
if  The_Ring . The_Top  =  0  then 

The_Ring . The_Top  ;=  The^Ring . The_Back ; 
end  if; 
end  if; 
end  Rotate; 

procedure  Mark  (The^Ring  :  in  out  Ring)  is 
begin 

The_Ring.TheJMark  ;=  The_Ring . The_Top ; 
end  Mark; 

procedure  Rotate_To_Mark  ('Ihe_Ring  :  in  out  Ring) 
is 

begin 

The^Ring .  The^Top  :  =  The_Ring .  The^Mark  ; 
end  Rotate_To_Jlark; 

—  modified  by  Tuan  Nguyen 

—  10  January  1996 

—  adding  procedures  to  replace  functions 


procedure  Insert  {The_Item  ;  in  Item; 

In_The_Ring  :  in  out  Ring)  is 

begin 

if  In_The„Ring.The_Back  =  In_The_Ring . The_Size 

then 

raise  Overflow; 

elsif  In_The_Ring.The_Back  =  0  then 
Iii_The_Ring .  The_Top  :  =  1 ; 

In^The_Ring . The^Back  ;=  1; 

In_The_Ring , The_Mark  :=  1; 

In_The_Ring .  The_I  terns  ( 1 )  :  =  The_I  t  em  ; 

else 

In_The__Ring .  The_I  terns 

( ( In_The_Ring . The_Top  +  1 )  . . 

{ In_The_Ring .  'Ihe_Back  +  1 ) }  :  = 

In^The_Ring .  The_I  terns  { In_The_Ring .  The_Top 


In^The_Ring.The_Back) ; 

In_The_Ring .  The_I  terns  ( In_The_Ring .  The_Top ) 

:=  The_Item; 

In_The_Ring . The_Back  := 
InL_The_Ring.The__Back  +  1; 

if  In_The_Ring.TheJ3ark  >= 

ln^The_Ring . The_Top  then 

In_The_Ring .  The_Mark  :  = 
In_The_Ring.The_Mark  +  1; 
end  if; 
end  if; 
end  Insert; 


procedure  Is_Equal  (Left  :  in  Ring; 

Right  :  in  Ring; 

Result  ;  out  Boolean)  is 

begin 

Result  :=  Is_Equal (Left, Right) ; 
end  Is_E<3ual; 

procedure  Extent_Of  (The_Ring  :  in  Ring; 

Result  :  out  Natural)  is 

begin 

Result  Extent_Of (The^Ring) ; 
end  Extent^Of; 

procedure  Is_Qr?>ty  (The_Ring  :  in  Ring; 

Result  :  out  Boolean)  is 

begin 

Result  :  =  Is^Erapty ( The_Ring )  ; 
end  Is_Eiqpty; 

procedure  Top_Of  (The_Ring  :  in  Ring; 

Result  ;  out  Item)  is 

begin 

Result  :=  Top_Of (The^Ring) ; 
end  Top_Of; 

procedure  AtJMark  (The_Ring  :  in  Ring; 

Result  :  out  Boolean)  is 

begin 

Result  : =  At_Mark { The_Ring ) ; 
end  AtJIark; 


procedure  Pop(The_Ring  :  in  out  Ring)  is 
begin 

if  The_Ring . The_Back  =  0  then 
raise  Underflow; 

elsif  The_Ring . The_Back  =  1  then 
The_Ring.The_Top  ;=  0; 

The_Ring . The_Back  : =  0 ; 

The_Ring.The_^Mark  :=  0; 

else 

The_Ring .  The_I  terns  { The_Ring .  The_Top  . . 
(The_Ring.The_Back  -  1))  := 

The^Ring .  The_I  terns  { ( The_Ring .  The_.Top  +  1 ) 
. .  The_Ring.The_Back) ; 

The_Ring.TheJBack  :=  The_Ring . The_Back  -  1; 
if  Theming . The_Top  >  The_Ring.The^Back 

then 


—  end  of  modification 

function  Is_Equal  (Left  :  in  Ring; 

Right  :  in  Ring)  return  Boolean 
is 

Left_Index  ;  Natural  :=  Left.The_Top; 

Right_Index  :  Natural  :=  Right . The_Top ; 
begin 

if  Left .The_Back  /=  Right .The^Back  then 
return  False; 

elsif  Lef t.The_I terns (Left_Index)  /= 

Right . The_I terns ( Right_Index )  then 
return  False; 

elsif  (Left .The_Mark  =  Left_Index)  and  then 
(Right .The_Mark  /=  Right^Index)  then 
return  False; 

else 


187 


Left_Index  :=  Left_Index  +  1; 
if  Left_lndex  >  Left .The^Back  then 
Left_Index  :=  1; 
end  if; 

Right_Index  :=  Right^Index  +  1; 
if  Right_Index  >  Right . The^Back  then 
Right_Index  :=  1; 
end  if; 

while  Left^Index  /=  Left.The^Top  loop 
if  Left.The_Iteins(Left_Index) 

Right . The_I terns ( Right_lndex )  then 
return  False; 

elsif  (Left.The^Mark  =  Left_Index)  and 
then  .  ,  , 

( Right. The_Mark  /=  Right_Index) 

then 

return  False; 

else 

Left_Index  ;=  Left_Index  +  1; 
if  Left_Index  >  Left .The^Back  then 
Left_Index  :=  1; 
end  if; 

Right_Index  :=  Right_Index  +  1; 
if  Right_Index  >  Right . The_Back 

then 

Right_Index  :=  1; 
end  if; 
end  if; 
end  loop; 

return  {Right_Index  =  Right . The^Top } ; 
end  if; 
exception 


when  Constraint_Error  => 

return  (Lef t .The^Top  =  Right .The^Top) ; 
end  Is_Equal; 

function  Extent_Of  (The_Ring  :  in  Ring)  return 
Natural  is 
begin 

return  The_Ring . The_Back ; 
end  Extent_Of; 


function  Is_En?)ty  (The_Ring  :  in  Ring)  return 
Boolean  is 
begin 

return  (The_Ring.The_Back  =  0); 
end  Is_En?)ty; 

ftinction  Top_0f  (The_Ring  :  in  Ring)  return  Item  is 
begin 

return  The_Ring . The_Iteins  (The_Ring . The_Top)  ; 
exception 

when  Constraint_Error  => 
raise  Underflow; 
end  Top_Of; 


fvmction  AtJIark  {The_Ring  :  in  Ring)  return 
Boolean  is 
begin 

return  { The_Ring  -  The_Top  =  The_Ring .  The_Kark ) ; 
end  AtJMark; 


end  Ring_Sequential_Bounded_JlanagedJIoniterator ; 
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RING  SEQUENTIAL  BOUNDED  MANAGED  NONITERATOR 

PSDL 


TYPE  Ring_Sequent  ial_BoimdedLJManagecLNoni  tera t or 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

FronuThe_Ring  :  Ring, 

To_The_Ring  :  Ring 
OUTPUT 

To_The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Ring  :  Ring 
OUTPUT 

The_Jling  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Insert 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

In_The_Ring  :  Ring 
OUTPUT 

In^The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate^Error 

END 

OPERATOR  Pop 
SPECIFICATION 
INPUT 

The_Ring  :  Ring 
OUTPUT 


The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate^Error 

END 

OPERATOR  Rotate 

SPECIFICATION 

INPUT 

The_Ring  :  Ring, 

In_The_Direction  :  Direction 
OUTPUT 

The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Mark 

SPECIFICATION 

INPUT 

The_Ring  :  Ring 
OUTPUT 

The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Rotate_To_Mark 

SPECIFICATION 

INPUT 

The_Ring  ;  Ring 
OUTPUT 

The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

END 

IMPLEMENTATION  ADA 

Ring_Sequential„BoundecLManaged_Noniterator 

END 
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RING  SEQUENTIAL  UNBOUNDED  MANAGED  ITERATOR 
ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

package  Ring_Sequential_Unbo\ande<3jManaged_Iterator  is 
type  Ring  is  liitdted  private; 
type  Direction  is  (Forward,  Backward) ; 


procedure  Copy 
Ring; 

Ring) ; 

procedure  Clear 
Ring) ; 

procedure  Insert 
I  tern; 

Ring) ; 

procedure  Pop 
Ring) ; 

procedure  Rotate 
Ring; 

Direction) ; 

procedure  Mark 
Ring) ; 

procedure  Rotate_To^Mark 
Ring) ; 

—  modified  by  Tuan  Nguyen 
10  January  1996 

—  adding  procedures  to  repl 


(FronuThe_Rang  :  xn 

To_The_Ring  :  in  out 

(The_Ring  :  in  out 

(The_Item  :  in 

In_The_Ring  :  in  out 

{The_Ring  :  in  out 

{The_Ring  :  in  out 

In_The_Direction  :  in 

(The_Ring  :  in  out 

(The_Ring  :  in  out 

ace  functions 


procedure  Is_Equal  (Left  :  in  Ring; 

Right  :  in  Ring; 
Result  :  out  Boolean) ; 
procedure  Extent_Of  (The_Ring  :  in  Ring; 

Result  :  out  Natural) ; 
procedure  Is_Enpty  (The_Ring  :  in  Ring; 


Result  :  out  Boolean) ; 
procedure  Top^Of  (The_Ring  :  in  Ring; 

Result  :  out  Item) ; 
procedure  At_Mark  (The_Ring  :  in  Ring; 

Result  :  out  Boolean) ; 

—  end  of  modification 

function  Is_Equal  (Left  :  in  Ring; 

Right  :  in  Ring)  return 

Boolean; 

function  Extent_0f  (The_Ring  :  in  Ring)  return 
Natural; 

function  Is_Enpty  {The_Ring  :  in  Ring)  return 
Boolean; 

function  Top_Of  {The_Ring  ;  in  Ring)  return 
Item; 

function  At_Mark  (The_Ring  :  in  Ring)  return 
Boolean; 

generic 

with  procedure  Process  (The_Item  :  in  Item; 

Continue  :  out 

Boolean) ; 

procedure  Iterate  (Over_The_Ring  ;  in  Ring) ; 

Overflow  :  exception; 

Underflow  :  exception; 

Rotate_Error  :  exception; 

private 

type  Node; 

type  Structure  is  access  Node; 
type  Ring  is 
record 

The_Top  :  Structure; 

TheJMark  :  Structure; 
end  record; 

end  Ring_Sequential_Unbounded_Managed_Iterator  ; 


190 


RING  SEQUENTIAL  UNBOUNDED  MANAGED  ITERATOR 
ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady 
Booch 

—  All  Rights  Reserved 

—  Serial  Niimber  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3) 

(ii) 

—  of  the  rights  in  Technical  Data  and  Cowputer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

with  StorageJManager_Sequential ; 

package  body  Ring_Sequential_UnboundedJlanaged_Iterator 
is 


type  Node  is 
record 

Previous  ;  Structure; 

The_Item  :  I tern; 

Next  ;  Structure; 
end  record; 

procedure  Free  (The_Node  :  in  out  Node)  is 
begin 

The^Node . Previous  ; =  null ; 
end  Free; 


procedure  Set_Next  (The_Node  :  in  out  Node; 

To_Next  :  in  Structure)  is 

begin 

The_Node.Next  :=  ToJJext; 
end  Set_Next; 

function  Next_Of  (TheJNode  :  in  Node)  return 
Structure  is 
begin 

return  TheJNode.Next ; 
end  Next_Of; 


package  NodeJManager  is  new 
Storage_Manager_Sequential 

Node, 

Structure, 

Free  -> 

Set_Pointer  => 
Pointer_Of  => 


(Item  => 

Pointer  => 

Free, 

Set^ext, 
Next^Of ) ; 


procedure  Copy  ( FrortuThe_Ring  :  in  Ring; 

To_The_Ring  :  in  out  Ring)  is 
From_Index  :  Structure 
Fron\_The_Ring .  The_Top ; 

To_Index  :  Structure; 
begin 

if  To_The_Ring.The_Top  /=  null  then 

To_The_Ring . The^Top . Previous . Next  ; =  null ; 
Node_M2ujager .  Free  ( To_The_Ring .  TheJTop )  ; 
end  if; 

if  From_The_Ring.The_Top  =  null  then 
To_The_Ring . Th€_Mark  :=  null; 

else 


To_„The_Ring .  The_Top  :  = 

Node_Manager  .New_Item; 

To^The_Ring.The_Top.The_Item  :  = 

From_Index .  The_Item ; 

To_Index  To_The_Ring ,  The_Top  ; 
if  FroiiL.The_Ring . The_Mark  =  From_Index  then 
To_The_Ring.The_Mark  :=  To^Index; 
end  if; 

Fr om_Index  :  =  Fr om.>Index .  Next ; 

while  From^Index  /=  FroTiL.The_Ring .  The_Top 

loop 

To_Index.Next  :=  NodeJManager .New_Item; 
To_Index . Next . Previous  : =  To_Index ; 

To_ Index . Next . The_I tern  : = 

Fronulndex .  The_I  tern; 

To_Index  : =  To^Index . Next ; 
if  FronuThe_Ring . The Jlark  =  From_Index 

then 


To_The_Ring.TheJSlark  To_Index; 
end  if; 

Fronuindex  :=  From_lndex.Next ; 
end  loop; 

To_The_Ring , The^Top . Previous  : =  To^Index ; 
To_Index.Next  :=  To_The_Ring.The_.Top; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Copy; 


procedure  Clear  (The_Ring  :  in  out  Ring)  is 


begin 

if  The_Ring . The_Top  /=  null  then 

The_Ring .  The_Top .  Previous . Next  :  =  null  ; 
Node_Manager .  Free  ( 'rhe_Ring .  The_Top )  ; 
The_Ring , The_Mark  :=  null; 
end  if; 
end  Clear; 


procedure  Insert  (The_Item  :  in  Item; 

In_The_Ring  :  in  out  Ring)  is 
Teir5>orary_Node  ;  Structure; 
begin 

if  In_The_Ring.The_Top  =  null  then 

In_The_Ring . The_Top  := 

Node_Manager .  New_I  tern ; 

IrL_The_Ring .  The_Top .  Previous  :  = 

In_The_Ring . The_Top ; 

In^The_Ring.The_Top.The_Item  :=  The_Item; 

In_The_Ring . The_Top . Next  : = 

In_The_Ring , The_Top ; 

In_The_Ring . The_Mark  : = 

In_The_Ring . The_Top ; 
else 

Temper ary_Node  Node_Manager  .New_Item; 

TemporaryjNode .  Previous  ;  = 

In_The_Ring . The_Top . Previous ; 

Teiip>orary_Node.The_Item  :=  The_Item; 

Tenporary_Node.Next  :=  In_The_Ring . The_Top ; 

In_The_Ring .  The_Top  :  =  Temporary_Node  ; 

ln_The_Ring . The_Top . Nex t . Previous  : = 
In_The_Ring . The_Top ; 

In_The_Ring .  The_Top .  Previous .  Next  :  = 
In^The_Ring . The_Top ; 
end  if; 
exception 

when  Storage_Error  => 

raise  Overflow; 
end  Insert; 


procedure  Pop(The_Ring  :  in  out  Ring)  is 
Tenporary_Node  ;  Structure ; 
begin 

Tempor ary_Node  :  =  The_Ring ,  The_Top  ; 
if  The_Ring . The_Top  =  The_Ring.The_Top.Next 

then 

The_Ring . The_Top  :=  null; 

The_Ring .  TheJIark  :  =  nul  1 ; 

else 

The_Ring .  The_Top .  Pr evi  ous .  Nex  t  :  = 
The_Ring . The_Top . Next ; 

'Ihe_Ring .  The_Top .  Next .  Previ  ous  :  = 
The_Ring . The_Top . Previous ; 

if  The_Ring ,  The_Mark  =  The_Ring .  The_Top 

then 


The_Ring .  The_Mark  ;  = 

The_Ring . The_Top . Next ; 

end  if; 

The_Ring . The_Top  r=  The_Ring.The_Top.Next; 
end  if; 

Teirporary_Node.Next  :=  null; 

NodeJManager .  Free  ( Temporary JJode )  ; 
exception 

when  Constraint_Error  => 
raise  Underflow; 


end  Pop; 


procedure  Rotate  (The_Ring  :  in  out  Ring; 

In_The_Direction  :  in 

Direction)  is 
begin 

if  In_The_Direction  =  Forward  then 

The_Ring.The_Top  :=  The_Ring.The_Top.Next; 

else 

The_Ring . The_Top  : = 

The_Ring . The_Top . Previous ; 
end  if; 
exception 

when  Constraint_Error  => 
raise  Rotate_Error ; 
end  Rotate; 

procedure  Mark  (The_Ring  ;  in  out  Ring)  is 
begin 

The_Ring . The_Mark  :=  The_Ring.The_Top; 
end  Mark; 

procedure  Rotate_To_Ma2^h  (The_Ring  :  in  out  Ring) 
is 

begin 

The_Ring.The_Top  :=  The_Ring.The_Mark; 
end  Rotate_To_Mark; 

—  modified  by  Tuan  Nguyen 
10  January  1996 

—  adding  procedures  to  replace  functions 

procedure  Is_Equal  (Left  :  in  Ring; 

Right  :  in  Ring; 
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Result  :  out  Boolean)  is 

begin 

Result  :=  Is^Equal (Left, Right) ; 
end  Is_Equal; 

procedure  Extent_Of  (The_Ring  :  in  Ring; 

Result  :  out  Natural)  is 

begin 

Result  : =  Ex t en t_0 f { The_Ring ) ; 
end  Extent_Of; 

procedure  Is_Eapty  {The_Ring  :  in  Ring; 

Result  :  out  Boolean)  is 

begin 

Result  :  =  Is_Enp ty  ( The_R ing )  ; 
end  Is^Enpty; 

procedure  Top_Of  (The_Ring  :  in  Ring; 

Result  ;  out  Item)  is 

begin 

Result  :=  Top_Of (The_Ring) ; 
end  Top^Of; 

procedure  At_Narlc  {The_Ring  ;  in  Ring; 

Result  :  out  Boolean)  is 

begin 

Result  :=  At_Mark(The_Ring) ; 
end  At_Mark; 


end  of  modification 


f\inction  Is_Equal  (Left  :  in  Ring; 

Right  r  in  Ring)  return  Boolean 
is 

Left_Index  :  Structure  ;=  Left .The^Top; 
Right_Index  :  Structure  ;=  Right .The_Top; 
begin 

if  Left_Index.The_Itein  /=  Right_Index.The_Item 

then 

return  False; 

elsif  (Left.TheJiark  =  Left_Index)  and  then 
( Right. The^rk  /=  Right^Index)  then 
return  False; 

else 

Left_Index  :=  Left_Index.Next ; 

Right_Index  :=  Right^Index.Next; 
while  Left_lndex  /=  Left.The^Top  loop 
if  Left_Index.The_Item  /= 
Right_Index.The_Item  then 

return  False; 

elsif  (Left .The_Mark  =  Left_Index)  and 


(Right. The JIark  /«  Right_Index)  then 
return  False ; 


Left_lndex  :=  Left_lndex.Next; 
Right_Index  ;=  Right_Index , Next ; 
end  if; 
end  loop; 

return  (Right_Index  =  Right .The_Top) ; 
end  if; 
exception 


when  Constraint^Error  => 

return  (Left. TheJTop  =  Right . The_Top ) ; 
end  Is_Equal; 

function  Extent_Of  (The_Ring  ;  in  Ring)  return 
Natural  is 

Count  :  Natural  :=  0; 

Index  :  Structure  ;=  The_Ring.The_Top; 
begin 

Index  :=  Index. Next; 

Count  :=  Cotmt  +  1; 

while  Index  /=  The^Ring . The_Top  loop 
Co\jnt  Count  +  1; 

Index  :=  Index. Next; 
end  loop; 
return  Count; 
exception 

when  Constraint_Error  “> 
return  0; 
end  Extent_Of; 


function  Is_Empty  (The_Ring  :  in  Ring)  return 
Boolean  is 
begin 

return  (The_Ring.The_Top  =  null); 
end  Is^Ecpty; 

function  Top_Of  (The_Ring  :  in  Ring)  return  Item  is 
begin 

return  The_Ring .  The_Top .  The_I tern; 
exception 

when  Cons train t_Error  «> 
raise  Underflow; 
end  Top_Of; 

function  At_Mark  (The_Ring  ;  in  Ring)  return 
Boolean  is 
begin 

return  (The_Ring.The_Top  =  The_Ring .The_Mark) ; 
end  AtJIark; 

procedure  Iterate  (Over_The_Ring  ;  in  Ring)  is 
The_Iterator  :  Structure  := 

Over_The_Ring .  The_Top  ; 

Continue  ;  Boolean; 

begin 

if  The_Iterator  /=  null  then 

Process (The_Iterator . The_I tern.  Continue } ; 
if  Continue  then 

The_Iterator  ;=  The_Iterator .Next; 
while  not  (The_lterator  = 

Over_The_Ring . The_Top )  loop 

Process (The_Iterator .The_Item, 

Continue) ; 

exit  when  not  Continue; 

The_Iterator  :=  The_I t era tor .Next ; 
end  loop; 
end  if; 
end  if; 
end  Iterate; 


end  Ring_Sequential_Unbounded_Managed_Iter ator ; 


192 


RING  SEQUENTIAL  UNBOUNDED  MANAGED  ITERATOR 


PSDL 


TYPE  Ring_Sequent  ial_Unboxmded,J4anagecLI  terator 
SPECIFICATION 
GENERIC 

Item  ;  PRIVATE_TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

From_The_Ring  :  Ring, 

To_The_Ring  :  Ring 
OUTPUT 

To_The_Ring  ;  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate^Error 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Ring  :  Ring 
OUTPUT 

The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Insert 
SPECIFICATION 
INPUT 

The_Item  ;  Item, 

In_The_Ring  :  Ring 
OUTPUT 

IrL.The_Ring  ;  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Pop 
SPECIFICATION 
INPUT 

The_Ring  :  Ring 
OUTPUT 

The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Rotate 
SPECIFICATION 
INPUT 

The_Ring  :  Ring, 

In_TheJ3irection  :  Direction 
OUTPUT 

The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Mark 
SPECIFICATION 
INPUT 

The_Ring  :  Ring 
OUTPUT 

The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Rotate„To_fIark 
SPECIFICATION 
INPUT 

The_Ring  :  Ring 
OUTPUT 


The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Is^Equal 

SPECIFICATION 

INPUT 

Left  :  Ring, 

Right  :  Ring 
OUTPUT 

Result  :  Booleemi 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Extent_Of 

SPECIFICATION 

INPUT 

The_Ring  :  Ring 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Is„Errpty 

SPECIFICATION 

INPUT 

The_Ring  ;  Ring 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Top_Of 

SPECIFICATION 

INPUT 

The_Ring  :  Ring 
OUTPUT 

Result  :  Item 
EXCEPTIONS 

Overflow,  Underflow,  Rotate^Error 

END 

OPERATOR  At_Nark 

SPECIFICATION 

INPUT 

The^Ring  :  Ring 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Iterate 

SPECIFICATION 

GENERIC 

Process  :  PROCEDURE [The_I tern  :  in[t  :  Item] 
Continue  :  out[t  :  Boolean]] 

INPUT 

Over_The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate^Error 

END 

END 

IMPLEMENTATION  ADA 

Ring_Seguential_Unbounded_ManagedLIterator 

END 
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RING  SEQUENTIAL  UNBOUNDED  MANAGED  NONITERATOR 
ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

package  Ring_Seciuential_UnboxindecLManagec3LJJoniterator 
is 

type  Ring  is  limited  private; 


type  Direction  is  {Forward,  Backward) ; 


procedure 

Ring; 

Copy 

(From_The_Ring 

To_The_Ring 

in 

out 

in 

Ring) ; 

( The_Ring 

in 

out 

procedure 

Clear 

Ring) ; 

procedure 
I  tern; 

Insert 

(The^Item 

In_The_Ring 

in 

out 

in 

Ring) ; 

(The_Ring 

out 

procedure 

Pop 

in 

Ring) ; 

procedure 

Ring; 

Rotate 

(The_Ring 

in 

out 

In^The_Dir ec  t ion 

in 

Direction) ; 

(The__Ring 

in 

out 

procedure 

Mark 

Ring) ; 

(The_Ring 

in 

out 

procedure 

Ro  t  a  te_To^ark 

Ring) ; 

—  modified  by  Tuan  Nguyen 

—  10  January  1996 

—  adding  procedures  to  replace  fxinctions 

procedure  Is_Equal  (Left  :  in  Ring; 

Right  :  in  Ring; 

Result  :  out  Boolean) ; 


procedure  Extent_0f  {The^Ring  :  in  Ring; 

Result  :  out  Natural ) ; 
procedure  Is_Einpty  {The_Ring  :  in  Ring; 

Result  ;  out  Boolean)  ; 
procedure  Top^Of  (The_Ring  :  in  Ring; 

Result  :  out  Item)  ; 
procedure  Atjlark  (The_Ring  :  in  Ring; 

Result  :  out  Boolean) ; 


end  of  modification 


f\inction  Is_Egual 

Boolean; 

(Left 

Right 

:  in 
;  in 

Ring  ; 
Ring) 

return 

function  Extent_0f 
Natural; 

{The_Ring  : 

;  in 

Ring) 

return 

function  Is^Eirpty 
Boolean; 

(The_Ring  ; 

I  in 

Ring) 

return 

function  Top_0f 
Item; 

(The_Ring  ; 

:  in 

Ring) 

return 

function  AtJWark 
Boolean; 

(The_Ring  ; 

;  in 

Ring) 

return 

Overflow  :  exception; 
Underflow  :  exception; 
Rotate^Error  :  exception; 


private 

type  Node; 

type  Structure  is  access  Node; 
type  Ring  is 
record 

The_Top  :  Structure; 

The_Mark  :  Structured- 
end  record; 

end  Ring_Sequent  ial_Unbounded_ManagedJJoni  t  era  tor ; 
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RING  SEQUENTIAL  UNBOUNDED  MANAGED  NONITERATOR 
ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady 
Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  {3) 

(ii) 

—  of  the  rights  in  Technical  Data  and  Computer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

with  StorageJManager_Sequential; 
package  body 

Ring_Sequential_Unbounded^anaged_lIoniterator  is 

type  Node  is 
record 

Previous 
The_Itein 
Next 

end  record; 

procedure  Free  (The_Node  ;  in  out  Node)  is 
begin 

The_Node . Previous  :=  null; 
end  Free; 

procedure  Set_Next  (The_Node  :  in  out  Node; 

To^Next  ;  in  Structure)  is 

begin 

The_Node.Next  :=  To_JJext; 
end  Set_Next; 

function  Next_Of  (The^ode  :  in  Node)  return 
Structure  is 
begin 

return  The^Node.Next; 
end  Next_Of; 


Structure; 

Item; 

Structure; 


package  NodeJMcuiager  is  new 
S  t orage_Nanager_Sequen t ia 1 

Node, 


(Item  => 

Pointer  => 


Structure, 

Free  =>  Free, 

Set_Pointer  =>  SetJtJext, 
Pointer^Of  =>  Next^Qf ) ; 


procedure  Copy  (From_The_Ring  :  in  Ring; 

To_The_Ring  :  in  out  Ring)  is 
From_Index  :  Structure 
Fr om_The_Ring . The_Top ; 

To_Index  :  Structure; 
begin 

if  To_The_Ring . TheJTop  /=  null  then 

To_The_Ring . The_Top . Previous . Next  : =  nul 1 ; 
Node Ji^ager . Free ( To_The_Ring , The_Top ) ; 
end  if; 

if  From_The_Ring . The_Top  =  null  then 
To_The_Ring - The^Mark  :=  null; 

else 

To_The_Ring.The_Top 
Node_Manager .  New_I  t  em 

To_The_Ring . The_Top . The_I t em  : = 

From_Index . The_I tern ; 

To_Index  To_The_Ring . The_Top ; 

if  From_The_Ring,The_Mark  =  From_Index  then 
To_The_Ring . TheJMark  : =  To_Index ; 
end  if; 

Fronuindex  :=  FronuIndex.Next; 

while  From_Index  /=  Froitt_The_Ring .  The^Top 

loop 

To_Index .  Next  :  =  Node JManager .  New_I t em ; 
To_Index .  Next .  Previous  :  =  To^Index ; 
To_Index . Next . The_I t em  : = 

Front-Index .  The_I  tern ; 

To_Index  :=  To_Index.Next; 
if  From_The_Ring . The_Mark  =  From_Index 


then 


To_The_Ring.The_Mark  ;=  To_Index; 
end  if; 

From_Index  :=  FroituIndex.Next ; 
end  loop; 

To_The_Ring-The_Top. Previous  :=  To_Index; 
To_Index.Next  :=  To_The_Ring . The_Top ; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 


end  Copy; 


procedure  Clear  (The_Ring  :  in  out  Ring)  is 


begin 

if  The_Ring.The_Top  /=  null  then 

The_Ring.The_Top. Previous, Next  :=  null; 
Node  JManager .  Free  ( The_Ring .  The_Top )  ; 
The_Ring.The_Mark  :=  null; 
end  if; 
end  Clear; 


procedure  Insert  (The_Item  ;  in  Item; 

In_The_Ring  :  in  out  Ring)  is 
TeirporaryJNode  :  Structure; 
begin 

if  In_The_Ring . The_Top  =  null  then 

In_The JRing . The_Top  :  = 

Node Jianager .  New_I  tern  ; 

In_The JRing .  The_Top .  Previous  :  = 

In_The_Ring .  The_Top  ; 

In_The_Ring.The_Top.The_Item  The_Item; 

In._The_Ring.The_Top.Next  ;  = 

In_The_Ring . The_Top ; 

In_The_Ring.The_Mark  := 

In_The_Ring . The_Top ; 
else 

Temper ary_Node  :=  Node_Manager  .New_Item; 

Tenporary_Node . Previous  : = 

In_The_Ring .  The_Top .  Previous  ; 

Tenporary_Node.The_Item  :=  The_Item; 

Temporary Jlode .  Next  :  =  In_The_Ring .  The_Top ; 

In_The_Ring.The_Top  :=  Teirporary_Node ; 

In_The_Ring .  The_Top .  Next .  Previous  :  = 
In_The_Ring . The_Top ; 

In_The_Ring .  The_Top  -  Previous . Next  :  = 
In_The_Ring . The_Top ; 
end  if; 
exception 

when  Storage_Error  => 

raise  Overflow; 
end  Insert; 


procedure  Pop(The_Ring  :  in  out  Ring)  is 
Tenporary_Node  :  Structure; 
begin 

Temper  ary JNode  :=  The_Ring .  The_Top  ; 
if  The_Ring.The_Top  =  The_Ring.The_Top.Next 

then 

The_Ring . The_Top  :=  null; 

The_Ring . The_JIark  :  =  null; 

else 

The_Ring .  The_Top .  Previous  .Next  :  = 
The_Ring . The_Top . Next ; 

The_Ring . The_Top . Next . Pr evi ous  : = 
The_Ring . The_Top . Previous ; 

if  The_Ring.The_Mark  =  The_Ring.The_Top 


then 


The_Ring.The_.Mark  :  = 

The_Ring . The_Top .Next ; 

end  if; 

The_Ring.The_Top  :=  The_Ring,The_Top.Next; 
end  if; 

TemporaryJNode . Next  : =  null; 

Node_Manager. Free (Temper ary„Node) ; 
exception 

when  Cons t rain t_Error  => 
raise  Underflow; 


end  Pop; 


procedure  Rotate  (The_Ring  :  in  out  Ring; 

In_The_Direction  :  in 

Direction)  is 
begin 

if  In_The_Direction  =:  Forward  then 

The_Ring.The_Top  :=  The_Ring . The_Top . Next ; 

else 

The_Ring . The_Top  : = 

The_Ring , The_Top . Previous ; 
end  if; 
exception 

when  Constraint_Error  => 
raise  Rotate_Error; 
end  Rotate; 

procedure  Mark  (The_Ring  :  in  out  Ring)  is 
begin 

The_Ring.The_Mark  :=  The_Jling . The_Top ; 
end  Mark; 

procedure  Rotate_To_^ark  (The_Ring  ;  in  out  Ring) 
is 

begin 

The_Ring.The_Top  :=  The_Ring.The_Mark; 
end  Rotate_To_Mark; 


—  modified  by  Tuan  Nguyen 

—  10  January  1996 

—  adding  procedures  to  replace  fvuoctions 

procedure  Is_Equal  (Left  :  in  Ring; 

Right  :  in  Ring; 
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Result  :  out  Boolean)  is 


begin 

Result  :=  Is_Equal (Left, Right) ; 
end  Is_Equal; 

procedure  Extent^Of  (The_Ring  :  in  Ring; 

Result  :  out  Natural)  is 

begin 

Result  :=  Extent_Of (The_Ring) ; 
end  Extent_Of; 

procedure  Is_Empty  (The^Ring  :  in  Ring; 

Result  :  out  Boolean)  is 

begin 

Resul t  :  =  Is_Eitp ty  { The^Ring ) ; 
end  Is_Eiiipty; 

procedure  Top_Of  (The^Ring  :  in  Ring; 

Result  :  out  Item)  is 

begin 

Result  :=  Top_Of {The_Ring) ; 
end  Top_Of; 

procedure  At_Mark  (The_Ring  ;  in  Ring; 

Result  :  out  Boolean)  is 

begin 

Result  ;=  At_Mark(The_Ring) ; 
end  At_Mark; 

—  end  of  modification 

function  ls_Equal  (Left  :  in  Ring; 

Right  :  in  Ring)  return  Boolean 
is 

Left_Index  :  Structure  :=  Left.The_Top; 
Right_Index  :  Structure  ;=  Right . The^Top ; 
begin 

if  Left_Index.The_Item  /=  Right_Index.The_Item 

then 

return  False; 

elsif  (Left,The_Mark  =  Left_Index)  and  then 
(Right.The_Nark  /=  Right_Index)  then 
return  False; 

else 

Left_Index  :=  Left_Index.Next; 

Right_Index  ;=  Right_Index.Next; 
while  Left_Index  /=  Left.The_Top  loop 
if  Left_lndex.The_Item  /= 

Righ t_Index . The_I tern  then 

return  False; 

elsif  (Left .The Jlark  =  Left_Index)  and 

then 


(Right.The_Nark  /=  Right_Index)  then 
return  False; 

else 

Left_Index  :=  Left_Index.Next; 
Right_Index  :=  Right_Index.Next ; 
end  if; 
end  loop; 

return  (Right_Index  =  Right .The_Top) ; 
end  if; 
exception 

when  Constraint_Error  => 

return  (Left. The_Top  =  Right . The_Top ) ; 
end  Is^Equal; 

function  Extent_Of  (The_Ring  ;  in  Ring)  return 
Natural  is 

Coxint  :  Natural  :=  0; 

Index  ;  Structure  :=  The_Ring . The_Top ; 
begin 

Index  :=  Index. Next; 

Count  :=  Count  +  1; 

while  Index  /=  The_Ring.The_Top  loop 
Co\int  :=  Count  +  1; 

Index  :=  Index. Next; 
end  loop; 
return  Count; 
exception 

when  Constraint_Error  *> 
return  0; 
end  Extent_Of; 

function  Is^Empty  (The_Ring  :  in  Ring)  return 
Boolean  is 
begin 

return  (The_Ring.The_Top  =  null) ; 
end  Is_Eirpty; 

ftinction  Top_Of  {The_Ring  :  in  Ring)  return  Item  is 
begin 

return  The^Ring . The^Top , The_I t em ; 
exception 

when  Constraint_Error  s> 
raise  Underflow; 
end  Top_Of; 

function  Atjlark  (The_Ring  :  in  Ring)  return 
Boolean  is 
begin 

return  ( The^Ring . The_Top  =  The_Ring . The_Mark ) ; 
end  At^Nark; 

end  Ring_Sequent ial_Unbounded_^IanagedJHonitera t or ; 
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RING  SEQUENTIAL  UNBOUNDED  MANAGED  NONITERATOR 

PSDL 


TYPE  Ring_Sequential_UnLbounded_Jlanaged_Noniterator 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

FroiiuThe_Ring  :  Ring, 

To_The_Ring  :  Ring 
OUTPUT 

To_The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate^Error 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The„Ring  :  Ring 
OUTPUT 

The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Insert 
SPECIFICATION 
INPUT 

The_I  t  em  :  I  tern , 

In_The_Ring  :  Ring 
OUTPUT 

In_The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate^Error 

END 

OPERATOR  Pop 
SPECIFICATION 
INPUT 

The^Ring  :  Ring 
OUTPUT 

The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Rotate 
SPECIFICATION 
INPUT 

The_Ring  :  Ring , 

In_The_pirection  :  Direction 
OUTPUT 

The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate^Error 

END 

OPERATOR  Mark 
SPECIFICATION 
INPUT 

The_Ring  :  Ring 
OUTPUT 

The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 


OPERATOR  Rotate_To_Mark 

SPECIFICATION 

INPUT 

The_Ring  :  Ring 
OUTPUT 

The_Ring  ;  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  ls_Egual 

SPECIFICATION 

INPUT 

Left  :  Ring, 

Right  ;  Ring 
OUTPUT 

Result  :  Booleein 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Extent_Of 

SPECIFICATION 

INPUT 

The_Ring  :  Ring 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Is_En?>ty 

SPECIFICATION 

INPUT 

The_Ring  :  Ring 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Top_Of 

SPECIFICATION 

INPUT 

The_Ring  :  Ring 
OUTPUT 

Result  :  Item 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  At Jlark 

SPECIFICATION 

INPUT 

The_Ring  :  Ring 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow,  Rotate^Error 

END 

END 

IMPLEMENTATION  ADA 

Ring_Sequent  i  al_Unbounded_JIanaged_Noni  t  era  tor 
END 
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RING  SEQUENTIAL  UNBOUNDED  UNMANAGED  ITERATOR 
ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

package  Ring_Sequential_UnboundedLUnmanageca_Iterator  is 
type  Ring  is  limited  private; 
type  Direction  is  (Forward,  Backward) ; 


procedure  Copy 
Ring  ; 

Ring) ; 

procedure  Clear 
Ring) ; 

procedure  Insert 
Item; 

Ring) ; 

procedure  Pop 
Ring) ; 

procedure  Rotate 
Ring  ; 

Direction) ; 

procedure  Mark 
Ring) ; 

procedure  Rotate_To_Mark 
Ring) ; 


( FroirL_The_Ring 
To_The_Ring 
(The_Ring 
(The_Item 
In_The_Ring 
(The_Ring 
{The_Ring 


:  in 

:  in  out 
:  in  out 
:  in 

:  in  out 
:  in  out 
:  in  out 


In_The_Direction  :  in 


{The_Ring 


:  in  out 


(The^Ring  :  in  out 


—  modified  by  Tuan  Nguyen 

—  10  January  1996 

—  adding  procedures  to  replace  fvinctions 


procedure  Is^Equal  (Left  :  in  Ring; 

Right  :  in  Ring; 

Result  :  out  Boolean) ; 

procedure  Extent_0f  (The_Ring  :  in  Ring; 

Result  :  out  Natural) ; 

procedure  Is_En?>ty  (The_Ring  :  in  Ring; 


Result  :  out  Boolean) ; 
procedure  Top_Of  (The_Ring  ;  in  Ring; 

Result  :  out  Item)  ; 
procedure  At_Mark  (The^Ring  :  in  Ring; 

Result  :  out  Boolean) ; 

—  end  of  modification 

function  Is_Equal  (Left  :  in  Ring; 

Right  ;  in  Ring)  return 

Boolean; 

function  Extent^Of  (The_Ring  ;  in  Ring)  return 
Natural ; 

function  ls_Empty  (The^Ring  ;  in  Ring)  return 
Boolean; 

function  Top_Of  {The_Ring  :  in  Ring)  return 
Item; 

function  AtJMark  (The_Ring  :  in  Ring)  return 
Boolean; 

generic 

with  procedure  Process  (The^Item  :  in  Item; 

Continue  :  out 

Boolean) ;  ... 

procedure  Iterate  (Over_The_Ring  :  in  Ring) ; 

Overflow  :  exception; 

Underflow  :  exception; 

Rotate_Error  :  exception; 

private 

type  Node; 

type  Structure  is  access  Node; 
type  Ring  is 
record 

The_Top  :  Structure; 

The_Mark  :  Structure; 
end  record; 

end  Ring_Seguential_Unbounded_Unmanaged_Iterator ; 
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RING  SEQUENTIAL  UNBOUNDED  UNMAN  AGED  ITERATOR 
ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady 
Booch 

—  All  Rights  Reserved 

—  Serial  Nxjinber  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3) 

(ii) 

—  of  the  rights  in  Technical  Data  and  Coinputer 

—  Software  Clause  of  FAR  52.227-7013.  Kcinufacturer : 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874} 


package  body 

Ring_Sequential_Unbounded_Unmanaged^Iterator  is 

type  Node  is 
record 

Previous  :  Structure; 

The_Item  :  I  tern; 

Next  :  Structure; 
end  record ; 


procedure  Copy  { Fron\_The_Ring  ;  in  Ring; 

To_The_Ring  :  in  out  Ring)  is 
Fronuindex  :  Structure  :« 

FroituThe_Ring  -  The^Top ; 

To_Index  ;  Structure; 
begin 

if  PronuThe_Ring . The_Top  =  null  then 
To_The_Ring . The_Top  :=  null; 

To_The_Ring . The_^rk  :=  null; 

else 

To_The_Ring .  The_Top  :s=!  new  Node '( Previous 

=>  null, 

The^Item 

=>  FronL.Index.The_Item, 

Next 

w>  null) ; 

To_Index  :=  To_The_Ring.The_Top; 
if  FronuThe_Ring . The_Nark  =  Froituindex  then 
To_The_Ring.TheJIark  :=  To_Index; 
end  if; 

From_Index  :=  From_Index.Next; 

while  Fronuindex  /=  FrortUrhe_Ring .  The^Top 

loop 

To_Index.Next  :=  new  Node  * (Previous  => 

To_Index, 

The_Item  => 

FroirL.Index .  The_Item, 

Next  => 

null) ; 

To_Index  To_ Index. Next; 

if  FroiiL.The_Ring .  The_Nark  =  Froin_Index 

then 

To_The_Ring.The_Mark  ;=  To_Index; 
end  if; 

From_lndex  :=  Fron\_Index .  Next ; 
end  loop; 

To_The_Ring .  The_Top .  Previous  ;  :=  To_Index  ,- 
To^Index.Next  :=  To_The_Ring . The^Top ; 
end  if; 
exception 

when  Storage^Error  *> 
raise  Overflow; 
end  Copy; 

procedure  Clear  (The_Ring  :  in  out  Ring)  is 
begin 

The^Ring  :=  Ring' (The_Top  =>  null, 

The_Mark  =>  null) ; 

end  Clear; 


procedure  Insert  (The__Item  :  in  Item; 

In_The_Ring  :  in  out  Ring)  is 

begin 

if  In_The_Ring.The_Top  =  null  then 

In_The_Ring . The_Top  : =  new  Node ‘ ( Previous 

=>  null, 

The_Item 

s:>  The_Item, 

Next 


=>  null) ; 

In_The_Ring . The_Top . Previous  : = 
In_The_Ring .  The_Top  ; 

In_The_Ring . The_Top . Next  : = 
In_The_Ring .  The_Top  ; 

In_The_Ring.TheJKark  :  = 
In_The_Ring . The_Top ; 
else 

In_The_Ring . The_Top  : = 
new  Node ' { Previous  => 
IrL_The_Ring .  The_Top .  Previous , 

The_Item  =>  The_Item, 


Next  => 

In_The_Ring.The_Top)  ; 

In„The_Ring . The_Top . Next . Previous  ; = 
Inw.The_Ring .  The_Top  ; 

In_The_Ring . The_Top . Previous , Next  : = 
In^The„Ring .  The_Top ; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Insert; 


procedure  Pop(The_Ring  :  in  out  Ring)  is 
begin 

if  The_Ring . The_Top  -  The_Ring.The_Top.Next 

then 

The_Ring.The_Top  ;=  null; 

The_Ring . The_Mark  : =  null ; 

else 

The_Ring . The_Top . Previous .Next  : » 
The_Ring . The_Top . Next ; 

The_Ring . The_Top . Next . Previous  : = 
The_Ring . The_Top . Previous ; 

if  The_Ring . The_Mark  =  The_Ring . The_Top 


then 


The_Ring .  The_Mark  :  = 

The_Ring .  The_Top .  Next ; 

end  if; 

The_Ring , The_Top  ;=  The_Ring,The_Top.Next; 
end  if; 
exception 

when  Constraint_Error  => 
raise  Underflow; 


end  Pop; 


procedure  Rotate  (The_Ring  ;  in  out  Ring; 

In_The_Direction  ;  in 

Direction)  is 
begin 

if  In_The_Direction  =  Forward  then 

The_Ring . The_Top  :=  The_Ring.The_Top.Next; 

else 

The_Ring , The_Top  : = 

The_Ring . The_Top . Previous ; 
end  if; 
exception 

when  Cons train t_Error  => 
raise  Rotate_Error ; 
end  Rotate; 

procedure  Mark  (The_Ring  :  in  out  Ring)  is 
begin 

The_Ring .  The_Mark  :  The_Ring .  The_Top  ; 
end  Mark; 

procedure  Rotate_To_Mark  (The_Ring  :  in  out  Ring) 
is 

begin 

The_Ring.The_Top  :=  The_Ring . The_Mark ; 
end  Rotate_To_Mark; 

—  modified  by  Tuan  Nguyen 

—  10  January  1996 

—  adding  procedures  to  replace  functions 

procedure  Is_Equal  (Left  ;  in  Ring; 

Right  :  in  Ring; 

Result  :  out  Boolean)  is 

begin 

Result  ; =  Is_Equal (Lef t , Right ) ; 
end  Is_Ec5ual; 

procedure  Extent_Of  (The_Ring  :  in  Ring; 

Result  :  out  Natural)  is 

begin 

Result  :=  Extent_Of (The_Ring) ; 
end  Extent_0f; 

procedure  Is_Einpty  (The_Ring  ;  in  Ring; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is_Einpty  (The_Ring)  ; 
end  Is_Enqpty; 

procedure  Top_Of  (The_Ring  ;  in  Ring; 

Result  :  out  Item)  is 

begin 

Result  i-  Top_0f (The_Ring) ; 
end  Top_Of; 

procedure  At_Mark  (The_Ring  ;  in  Ring; 

Result  ;  out  Boolean)  is 

begin 

Resu It  : =  At JMar k ( The_Ring ) ; 
end  At_Mark; 

—  end  of  modification 
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function  Is^Equal  {Left  :  in  Ring; 

Right  :  in  Ring)  return  Boolean 
is 

Left_Index  :  Structure  :=  Left .The_Top; 
Right_Index  :  Structure  :=  Right .The_Top; 
begin 

if  Left_Index.The_Item  /=  Right_Index,The_Item 

then 

return  False; 

elsif  (Left.The_Mark  =  Left_Index)  and  then 
( Right. The^Mark  /=  Right_Index)  then 
return  False; 

else 

Left_Index  Left_Index.Next ; 

Right_Index  :=  Right_Index.Next ; 
while  Left_Index  /=  Left.The^Top  loop 
if  Left_Index,The_Item  /= 

Right_Index . The_Item  then 

return  False; 

elsif  (Left.The_Wark  =  Left^Index)  and 


then 

(Right  .The.^rk  /=  Right_Index)  then 
return  False; 

else 

Left_Index  :=  Lef t_Index-Next; 
Right_Index  :=  Right_Index , Next ; 
end  if; 
end  loop; 

return  (Right_Index  =  Right .The^Top) ; 
end  if; 
exception 

when  Constraint_Error  => 

return  (Left .The_Top  =  Right .The_Top) ; 
end  Is^Ecjual; 


function  Extent_Of  (The_Ring  :  in  Ring)  return 
Natural  is 

Count  ;  Natural  0; 

Index  :  Structure  The_Ring.The_Top; 

begin 

Index  :=  Index. Next; 

Coimt  :=  Count  +  1; 

while  Index  /=  The_Ring.The_Top  loop 
Count  :=  Count  +  1; 

Index  :=  Index. Next; 
end  loop; 
return  Count; 


exception 

when  Cons train t_Error  => 
return  0; 
end  Extent_Of; 

function  Is_Enpty  {The_Ring  :  in  Ring)  return 
Boolean  is 
begin 

return  {'nie_Ring.The_Top  =  null)  ; 
end  Is^Ernpty; 

function  Top_Of  (The_Ring  :  in  Ring)  return  Item  is 
begin 

re  turn  The_Ring .  The^Top .  The_I  tern ; 
exception 

when  Constraint_Error  => 
raise  Underflow; 
end  Top_Of; 

function  At_Nark  (The_Ring  :  in  Ring)  return 
Boolean  is 
begin 

re  turn  { The_Ring . The_Top  =  The_Ring . The  Jlar k ) ; 
end  At_Mark; 

procedure  Iterate  (Over^The_Ring  ;  in  Ring)  is 
The_Iterator  :  Structure  := 

C>ver_The_Ring .  The_Top ; 

Continue  :  Boolean; 

begin 

if  The_Iterator  /=  null  then 

Process (The_Iterator.The_Item,  Continue) ; 
if  Continue  then 

The_Iterator  The_Iterator .Next; 

while  not  (The_Iterator  = 
Over_The_Ring.The_Top)  loop 

Process ( The_Itera tor . The_I tern. 

Continue) ; 

exit  when  not  Continue; 

The_Iterator  :=  The_I t era tor .Next ; 
end  loop; 
end  if; 
end  if; 
end  Iterate; 

end  Ring^Sequent  ial„UnboundecLUninanaged_I  t  erator ; 
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RING  SEQUENTIAL  UNBOUNDED  UNMANAGED  ITERATOR 

PSDL 


TYPE  Ring_Sequential_Unbounded_Uninanaged_Iterator 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

Front.The_Ring  :  Ring , 

To_The_Ring  :  Ring 
OUTPUT 

To_The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Ring  ;  Ring 
OUTPUT 

The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Insert 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

IrL.The_Ring  :  Ring 
OUTPUT 

In_The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate„Error 

END 

OPERATOR  Pop 
SPECIFICATION 
INPUT 

The_Ring  :  Ring 
OUTPUT 

The_Ring  ;  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Rotate 
SPECIFICATION 
INPUT 

The_Ring  :  Ring , 

In_The_Direction  :  Direction 
OUTPUT 

The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate^Error 

END 

OPERATOR  Mark 
SPECIFICATION 
INPUT 

The_Ring  :  Ring 
OUTPUT 

The__Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Rotate_To_Mark 
SPECIFICATION 
INPUT 

The_Ring  :  Ring 
OUTPUT 


The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Is_Egual 

SPECIFICATION 

INPUT 

Left  :  Ring, 

Right  :  Ring 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Extent_Of 

SPECIFICATION 

INPUT 

The_Ring  :  Ring 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Is„Etnpty 

SPECIFICATION 

INPUT 

The^Ring  :  Ring 
OUTPUT 

Result  ;  Boolean 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Top_Of 

SPECIFICATION 

INPUT 

The_Ring  :  Ring 
OUTPUT 

Result  :  Item 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  At  Jlark 

SPECIFICATION 

INPUT 

The^Ring  :  Ring 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Iterate 

SPECIFICATION 

GENERIC 

Process  :  PROCEDURE [The_I tern  ;  in[t  :  Item] 
Continue  :  out(t  :  Boolean]] 

INPUT 

Over_The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

END 

IMPLEMENTATION  ADA 

Ring_SeqEuential_Unbounded_Unmanaged_lterator 

END 
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RING  SEQUENTIAL  UNBOUNDED  UNMANAGED  NONITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

package  Ring„Sequential_Unbounded_Uriinanaged_Noniterator 

is 

type  Ring  is  limited  private; 

type  Direction  is  (Forward,  Backward); 


procedure  Copy 
Ring; 

Ring) ; 

procedure  Clear 
Ring) ; 

procedure  Insert 
I  tern; 

Ring) ; 

procedure  Pop 
Ring) ; 

procedure  Rotate 
Ring; 

Direction) ; 

procedure  Mark 
Ring)  ; 

procedure  Ro  t  a t e_To_Mark 
Ring)  ; 

—  modified  by  Tuan  Nguyen 

—  10  January  1996 

adding  procedures  to  rep! 


( FrortuThe_Ring  :  in 

To_The_Ring  :  in  out 

(The_Ring  :  in  out 

(The_Item  :  in 

In_The_Ring  :  in  out 

(The_Ring  :  in  out 

{The_Ring  :  in  out 

In_The_Direction  :  in 

{The_Ring  :  in  out 

(The_Ring  :  in  out 


functions 


procedure  Is^Egual  (Left  ;  in  Ring; 

Right  :  in  Ring; 

Result  ;  out  Boolean) ; 


procedure  Extent_Of  (The_Ring  :  in  Ring; 

Result  :  out  Natural) ; 
procedure  Is_Eiipty  {The_Ring  :  in  Ring; 

Result  :  out  Boolean) ; 
procedure  Top_0£  {The_Ring  ;  in  Ring; 

Result  :  out  Item) ; 
procedure  At_>Iark  (The_Ring  :  in  Ring; 

Result  :  out  Booleain) ; 

—  end  of  modification 

function  Is_Equal  (Left  :  in  Ring; 

Right  :  in  Ring)  return 

Boolean; 

function  Extent_Of  (The_Ring  :  in  Ring)  return 
Natural ; 

function  Is_Enpty  (The_Ring  :  in  Ring)  return 
Boolean; 

function  Top_0f  (The_Ring  :  in  Ring)  return 
Item; 

function  At_Mark  (The_Ring  :  in  Ring)  return 
Boolean; 

Overflow  :  exception; 

Underflow  :  exception; 

Rotate_Error  :  exception; 

private 

type  Node; 

type  Structure  is  access  Node; 
type  Ring  is 
record 

The_Top  ;  Structure; 

The_Mark  :  Structure; 
end  record; 

end  Ring_Sequential_Unbounded^UnmcinagecLKoniterator ; 
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RING  SEQUENTIAL  UNBOUNDED  UNMANAGED  NONITERATOR 


ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady 
Booch 

—  All  Rights  Reserved. 

—  Serial  Number  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3) 
(ii) 

—  of  the  rights  in  Technical  Data  and  Computer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  {1-303-987-1874} 


package  body 

Ring_Sequential_Unbo\jnded_Uninanaged^Noniterator  is 


type  Node  is 
record 

Previous  :  Structure; 
The_ltem  :  Item; 

Next  :  Structure; 

end  record; 


procedure  Copy  ( FroiTL.The_Ring  :  in  Ring; 

To_The_Ring  :  in  out  Ring)  is 
Fronuindex  :  Structure  := 

FrortL_The_Ring .  The_Top ; 

To_Index  :  Structure; 
begin 

if  FrotrL.The_Ring.The_Top  =  null  then 
To_The_Ring . The_Top  : =  null ; 

To_The_Ring .The_Mark  :*  null; 

else 

To_The_Ring.The_Top  :=  new  Node ‘  (Previous 

=>  null, 

The_Item 

=>  FroiiL_Index.The_Item, 

Next 


=>  null) ; 


loop 

To^Index, 


To^Index  : =  To_The_Ring . The_Top  ; 
if  From_The_Ring.The_Mark  =  Froituindex  then 
To_TheJRing.TheJttark  ;=  To_Index; 
end  if; 

Fron\_Index  :  =  Fron\_Index .  Next ; 

while  Fronuindex  FrortuThe_Ring .  The_Top 

To_Index.Next  ;=  new  Node '{ Previous  => 

The_Item  => 


Fr  onuindex .  'nie_I  tem , 


Next  => 


null) ; 

To„Index  ;=  To_Index.Next; 
if”FroirL.The_Ring.The_Mark  =  Fronuindex 


then 


To_The_Ring . The^Mark  : =  To^Index ; 
end  if; 

Fronuindex  :=  Fronuindex. Next; 
end  loop; 

To_Thc_Ring . The_Top . Previous  : =  To_Index ; 
To_Index.Next  :=  To_The_Ring.The_Top; 
end  if; 
exception 

when  Storage^Error  => 
raise  Overflow; 
end  Copy; 


procedure  Clear  (The_Ring  :  in  out  Ring)  is 
begin 

The_Ring  :!s  Ring'  (The_Top  =>  null, 
The_Mark  =>  null) ; 

end  Clear; 


procedure  Insert  {The„Item  :  in  Item; 

In_The_Ring  :  in  out  Ring)  is 

begin 

if  In_The_Ring.The^Top  =  null  then 

In_The_Ring.The_Top  :=  new  Node '( Previous 


=>  null. 


The_Item 


=>  The^Item, 


Next 


=>  null) ; 

In_The__Ring .  The_Top ,  Previous  :  = 
In_The_Ring . The_Top ; 

In^The_Ring .  The_Top  -  Next  :  = 
InuThe_Ring .  The_Top ; 

In_The_Ring,The_Mark  := 
IruThe_Ring .  The_Top  ; 
else 

In^The_Ring.The_Top  := 
new  Node' (Previous  => 
In_The_Ring  .The_Top .  Previous , 

The^Item  =>  The_Item. 


Next  => 

In_The_Ring.The_Top) ; 

In_The_Ring . The_Top . Next . Pr evi ous  : = 
In_The_Ring . The_Top ; 

In_The_Ring .  'rhe_Top .  Previ  ous  .  Next  :  = 
In_The_Ring . The_Top ; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Insert; 


procedure  Pop(The_Ring  :  in  out  Ring)  is 
begin 

if  The_Ring.The_Top  =  The_Ring.The__Top.Next 

then 

The_Ring . The_Top  ; =  null ; 

The_Ring . The_Mark  :=  null; 

else 

The__Ring .  The_Top .  Previous .  Next  :  = 
The_Ring . The_Top . Next ; 

The_Ring . The_Top . Next . Previous  : = 
The_Ring . The_Top . Previous ; 

if  The_Ring.The_Mark  =  The_Ring . The_Top 


then 


The_Ring . The_Mark  ; = 

The_Ring . The_Top . Next ; 

end  if; 

The_Ring.The_Top  :=  The_Ring,The_Top.Next; 
end  if; 
exception 

when  Constraint_Error  => 
raise  Underflow; 


end  Pop; 


procedure  Rotate  (The_Ring  :  in  out  Ring; 

In_The_Direction  :  in 

Direction)  is 
begin 

if  ln_The_Direction  =  Forward  then 

The_Ring .  The_Top  ;  =  The_Ring .  The_Top .  Nex t ; 

else 

The_Ring . The_Top  : * 

The_Ring . The_Top . Previous ; 
end  if; 
exception 

when  Constraint_Error  «> 
raise  Rotate_Error ; 
end  Rotate; 

procedure  Mark  {The_Ring  :  in  out  Ring)  is 
begin 

The_Ring  -  The.Jlark  ;  =  The_Ring .  The_Top  ; 
end  Hark; 

procedure  Rotate_To_JM[ark  (The_Ring  :  in  out  Ring) 
is 

begin 

The_Ring.The_Top  The_Ring . The.Jlark ; 

end  Rotate_To__Hark; 

—  modified  by  Tuan  Nguyen 

—  10  January  1996 

—  adding  procedures  to  replace  functions 

procedure  Is_Equal  (Left  :  in  Ring; 

Right  :  in  Ring; 

Result  :  out  Boolean)  is 

begin 

Result  ; =  l5_Equal (Left, Right) ; 
end  Is_Ec3ual; 

procedure  Extent_Of  (The_Ring  :  in  Ring; 

Result  :  out  Natural)  is 

begin 

Result  :=  Extent_Of (The_Ring) ; 
end  Extent_Of; 

procedure  Is_Ecnpty  (The_Ring  ;  in  Ring; 

Result  :  out  Boolean)  is 

begin 

Result  Is_Eirpty(The_Ring)  ; 
end  Is_Empty; 

procedure  Top_0f  (The_Ring  :  in  Ring; 

Result  ;  out  Item)  is 

begin 

Result  Top_Of  (The_Ring) ; 
end  Top_0f; 

procedure  At_Mark  (The_Ring  :  in  Ring; 

Result  :  out  Boolean)  is 

begin 

Result  :=  At_Mark(The__Ring)  ; 
end  At_Mark; 

—  end  of  modification 
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function  Is_Equal  (Left  :  in  Ring; 

Right  ;  in  Ring)  return  Boolean 
is 

Left_Index  :  Structure  :=  Lef t .The^Top; 
Right_Index  ;  Structure  :=  Right .The_Top; 
begin 

if  Left_Index.The_Item  /s  Right_Index.The_Item 

then 

return  False; 

elsif  (Left.The_>lark  =  Left_Index)  and  then 
{ Right. The_Mark  /=  Right_Index)  then 
return  False; 

else 

Left_Index  :=  Left^Index.Next; 

Right_lndex  :=  Right_Index.Next ; 
while  Left_lndex  /=  Left.The„Top  loop 
if  Left„Index.The_Itein  I- 
Right_Index .  The_I  tern  then 

return  False; 

elsif  (Left.The_Wark  ^  Left_Index}  and 

then 

(Right.The_Mark  /=  Rxght_Index)  then 
return  False; 

else 

Left^Index  :=  Left_Index.Next; 
Right_Index  :=  Right_Index.Next ; 
end  if; 
end  loop; 

return  (Right_Index  =  Right.The_Top) ; 
end  if; 
exception 

when  Constraint_Error  => 

return  (Left .The^Top  =  Right .The_Top) ; 
end  Is_Equal; 

fiinction  Extent^Of  (The_Ring  :  in  Ring)  return 
Natural  is 


Coxint  :  Natural  :=  0; 

Index  :  Structure  :=  The_Ring . The^Top ; 
begin 

Index  :=  Index. Next; 

Count  :=  Count  +  1; 

while  Index  /=  The_Ring . The_Top  loop 
Count  Count  +  1; 

Index  :=  Index. Next; 
end  loop; 
return  Count; 
exception 

when  Constraint_Error  => 
return  0; 
end  Extent_Of; 

function  Is_Eitpty  (The_Ring  :  in  Ring)  return 
Boolean  is 
begin 

return  (The_Ring.The_Top  =  null) ; 
end  Is_Ert5>ty; 

function  Top_Of  (The_Ring  :  in  Ring)  return  Item  is 
begin 

re  turn  The_Ring .  The  JTop .  The_I  tern ; 
exception 

when  Constraint_Error  => 
raise  Underflow; 
end  Top_Of; 

function  At^JIark  (The_Ring  :  in  Ring)  return 
Boolean  is 
begin 

return  (The_Ring.The_Top  =  The_Ring.The„Mark) ; 
end  At_Mark; 

end  Ring_Sequential_Unbounded_UninanagecLNoniterator ; 
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RING  SEQUENTIAL  UNBOUNDED  UNMAN  AGED  NONITERATOR 

PSDL 


TYPE  Ring_Sequential_Unbounded^UninanagecLNoniterator 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

Froin_The_Ring  :  Ring, 

To_The_Ring  :  Ring 
OUTPUT 

To_The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate^Error 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Ring  :  Ring 
OUTPUT 

The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Insert 
SPECIFICATION 
INPUT 

The_Item  ;  Item, 

In_The_Ring  :  Ring 
OUTPUT 

In_The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Pop 
SPECIFICATION 
INPUT 

The_Ring  :  Ring 
OUTPUT 

The^Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Rotate 
SPECIFICATION 
INPUT 

The_Ring  :  Ring, 

In_„The_Direction  :  Direction 
OUTPUT 

The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Mark 
SPECIFICATION 
INPUT 

The_Ring  :  Ring 
OUTPUT 

The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 


OPERATOR  Rotate_To_J!ark 

SPECIFICATION 

INPUT 

The_Ring  :  Ring 
OUTPUT 

The_Ring  :  Ring 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Is_Equal 

SPECIFICATION 

INPUT 

Left  :  Ring, 

Right  :  Ring 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Extent_Of 

SPECIFICATION 

INPUT 

The^Ring  :  Ring 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow,  Rotate^Error 

END 

OPERATOR  ls_En¥>ty 

SPECIFICATION 

INPUT 

The_Ring  :  Ring 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  Top_Of 

SPECIFICATION 

INPUT 

The_Ring  :  Ring 
OUTPUT 

Result  :  Item 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

OPERATOR  At_Mark 

SPECIFICATION 

INPUT 

The_Ring  :  Ring 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow,  Rotate_Error 

END 

END 

IMPLEMENTATION  ADA 

Ring_Sequen  t  i  al_Unt>o\mded_UnmanagecLJJoni  terat  or 
END 
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SETS  0BJ3  SPECIFICATIONS 


obj  SETtX  : :  TRIV]  is  sort  Set  . 
protecting  NAT  . 

***  constructors 


op  create 
op  copy 

Set 

->  Set 
Set  ->  Set 

op  clear 

Set 

->  Set  . 

op  add 

Elt 

Set  “>  Set 

op  remove 

Elt 

Set  ->  Set 

op  union 

Set 

Set 

Set  •“>  Set 

op  intersection 

Set 

Set 

Set  ->  Set 

op  difference 

Set 

Set 

Set  “>  Set 

♦*  accessors 

op  isequal 

Set 

Set 

->  Bool  . 

op  extentof 

Set 

->  Nat  . 

op  isen^ty 

Set 

->  Bool  . 

op  isamember 

Elt 

Set 

->  Bool  . 

op  isasubset 

Set 

Set 

->  Bool  . 

op  isapropersubset 

Set 

Set 

->  Bool  . 

♦*  exceptions 

op  overflow 

->  Set 

op  itemisinset 

->  Set 

op  itemisnotinset 

->  Set 

***  varicibles  declaration 

var  S  SI  S2  :  Set  . 
var  E  El  :  Elt  . 

***  axioms 

eq  copy (S, SI)  =  S  . 


eq  clear (S)  =  create  . 

eq  remove (E, create)  itemisnot inset  . 

eq  remove (E,add(El, SI) )  =  if  E  ==  El  then  SI  else 
add(El, remove (E, SI) )  fi  • 

eq  union(S, create, SI)  =  S  .  . 

eq  union(S,add(El,Sl) ,S2)  =  if  isamember (El, S)  then  union (S, SI, S2) 
else  add(El,union{S,Sl,S2) )  fi  , 

eq  intersection{S, create, SI)  =  create  . 

eq  intersection{S,add{El,Sl) ,S2)  =  if  isamember (El, S)  then 
add (El, intersection (S, SI, S2) )  else  intersection(S, SI, S2)  fi  • 

eq  difference (create, S, SI)  =  S  . 

eq  difference (S, create, SI)  =  S  . 

eq  difference {S,add(El, SI) , S2)  =  if  isamember (El, S)  then 
difference (remove (El, S) , SI, S2)  else  add (El, difference (S, SI, S2) )  fi  . 

eq  isequal (S,S1)  »  S  ==  SI  . 

eq  extentof (create)  =  0  . 

eq  extentof (add {E,S) )  =  1  +  extentof (S)  . 

eq  isamember (E, create)  =  false  . 

eq  isamember (E, add (El, Si) )  *  E  ==  El  or  isamember (E, SI)  . 

eq  isasubset (create, S)  =  true  . 

eq  isasubset (add(E,S) , SI)  =  if  isamember (E, SI)  then 
isasubset ( S, remove (E, SI) )  else  false  fi  . 

eq  isapropersubset  (S,S1)  =  isasiabset  (S,S1)  and  extentof  (SI)  > 
extentof (S)  . 

endo 
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SET  PROFILE  CODES 


OPERATORS 

SIGNATURES 

PROFILE  CODES 

COPY 

AB->B 

3211 

CLEAR 

A->A 

2201 

ADD 

AB->B 

3211 

REMOVE 

AB->B 

3211 

UNION 

ABC->C 

4231 

INTERSECTION 

ABC->C 

4231 

DIFFERENCE 

ABC->C 

4231 

IS.EQUAL 

AB->C 

330 

EXTENT_OF 

A->B 

220 

IS_EMPTY 

A->B 

220 

IS_A_MEMBER 

AB->C 

330 

IS_A_SUBSET 

AB->C 

330 

IS_A_PROPER_SUBSET 

AB->C 

330 

SET  OF  PROFILE:  {4231,321 1,2201,330,220} 
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SET  SIMPLE  SEQUENTIAL  BOUNDED  MANAGED  ITERATOR 
ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

package  Set_Sinple_Sequential_Bounded_Managed_Iterator  is 


type  Set{The_Size  :  Positive)  is  limited  private; 


procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 


Copy 

Clear 

Add 

Remove 

Union 

Intersection 

Difference 


(FromJThe^Set 

To_The_Set 

(The_Set 

(The_Item 

To„The_Set 

(The_Item 

From_The_Set 

(Of_The_Set 

AndLThe^Set 

To_The_Set 

(Of_The_Set 

And_The_Set 

To_The_Set 

(Of_The_Set 

And_The_Set 

To_The_Set 


in 

Set; 

in 

out 

Set) 

in 

out 

Set) 

in 

Item 

in 

out 

Set) 

in 

Item 

in 

out 

Set) 

in 

Set; 

in 

Set; 

in 

out 

Set) ; 

in 

Set; 

in 

Set; 

in 

out 

Set); 

in 

Set; 

in 

Set; 

in 

out 

Set) ; 

—  modified  by  Tuan  Nguyen 

—  20  Aug  95 

—  replacing  ftmctions  with  procedures 


procedure  Is_Equal 


procedure  Extent_Of 
procedure  Is_E[npty 
procedure  Is_JV_^ein)3®r 


(Left 

Right 

Result 

(The_Set 

Result 

(The^Set 

Result 

(The_Item 

Of_The_Set 

Result 


in  Set; 
in  Set; 
out  Boolean) ; 
in  Set; 
out  Natural) ; 
in  Set; 
out  Boolean) ; 
in  Item; 
in  Set; 
out  Boolean) ; 


procedure  ls_A_Subset 
procedure  Is_AwProper_Subset 

end  of  modification 

function  Is_Equal 

function  Extent_Of 
function  Is_Empty 
function  Is_A_Merober 

fxjnction  Is_A».Subset 

function  Is_A_Proper_Subset 


(Left 

;  in  Set; 

Right 

:  in  Set; 

Result 

:  out  Boolean) 

(Left 

;  in  Set; 

Right 

:  in  Set; 

Result 

:  out  Boolean) 

(Left 

in 

Set; 

Right 

in 

Set) 

return 

Boolean; 

(The^Set 

in 

Set) 

return 

Natural 

(The_Set 

in 

Set) 

return 

Boolean; 

(The_Item 

in 

I  tern; 

Of_The_Set 

in 

Set) 

return 

Boolean; 

(Left 

in 

Set; 

Right 

in 

Set) 

return 

Boolean; 

(Left 

in 

Set; 

Right 

in 

Set) 

return 

Boolean; 

generic 

with  procedure  Process  (The_Item 
Continue 

procedure  Iterate  (Over_The„Set  :  in 


:  in  Item; 

:  out  Boolean) ; 
Set)  ; 


Overflow  :  exception; 
IteiiuIs_In_Set  :  exception; 
IteituIs_Not_In_Set  :  exception; 


private 

type  Items  is  array (Positive  range  <>)  of  Item; 
type  Set(The_Size  :  Positive)  is 
record 

The^Back  ;  Natural  :=  0; 

The_I terns  :  Items (1  ..  The_Size) ; 
end  record; 

end  Set_Simple_Sequential_Bo\mdecLKanaged_I terator ; 
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SET  SIMPLE  SEQUENTIAL  BOUNDED  MANAGED  ITERATOR 
ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 
—All  Rights  Reserved 


—  Serial  Number  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  s\ibdivision  {b)  {3)  {ii) 

—  of  the  rights  in  Technical  Data  and  Conputer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

--  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body  Set_SiiiT>le_Sequential„Bouiided_Managed_Iterator  is 

procedure  Copy  (Froiit.The_Set  :  in  Set; 

To_The_Set  :  in  out  Set)  is 

begin 

if  FrorcL.The_Set.The_Back  >  To__The_Set .The_Size  then 
raise  Overflow; 

else 

To_The  Set .  The_I terns  (1  . .  FroiruThe_Se t .  The_Back )  :  = 
FrortL.The_Set  - The^Items  (1  .  .  FroiTuThe_Set . The_Back)  ; 
To_The_Set.The_Back  :=  From_The_Set .The_Back; 
end  if; 
end  Copy; 

procedure  Clear  (The_Set  :  in  out  Set)  is 
begin 

The_Set.The_Back  :=  0; 
end  Clear; 


procedure  Add  {The_Item  :  in  Item; 

To_The_Set  :  in  out  Set)  is 

begin 

for  Index  in  1  . .  To_The_Set .The_Back  loop 

if  The_Item  =  To_The_Set.The_I terns (Index)  then 
raise  Item_Is_In_Set; 
end  if; 
end  loop; 

To_The_Set .The_I terns (To_The_Set.The_Back  +1)  :=  The_Item; 

To_TheIset.The_Back  :=  To_The_Set .The_Back  +  1; 
exception 

when  Constraint_Error  => 
raise  Overflow; 

end  Add; 


And_Index  :  Natural; 
begin 

To_The_Set.The_Back  :=  0; 

for  Of^Index  in  1  . .  Of_The_Set .The_Back  loop 
AndLIndex  :=  And_The_Set  .'nie_Back; 
while  AndLIndex  >  0  loop 

if  Of_The_Set.The_I terns (Of^Index)  = 

AncLThe_Se  t .  The_I  t  ems  ( And_Index }  then 
To_The.„Set.The_Iteins{To_The_Set.The_Back  +  1) 
Of_The_Set  .The_I terns  (Of _Index)  ; 

To_The_Set  .The^Back  :=  To_The_Set .  The_Back  +  1 
exit; 

else 

AndLIndex  :=  AndLIndex  -  1; 
end  if; 
end  loop; 
end  loop; 
exception 

when  Constraint_Error  *:> 
raise  Overflow; 
end  Intersection; 

procedure  Difference  (Of_The_Set  :  in  Set; 

AndLThe_Set  :  in  Set; 

To_The_Set  :  in  out  Set)  is 

AndLIndex  :  Natural; 
begin 

To_The_Set . The_Back  : =  0 ; 

for  Of_Index  in  1  . .  Of_The_Set .The_Back  loop 
AndLIndex  :=  AndLThe_Set  .The_Back; 
while  AndLIndex  >  0  loop 

if  Of_The_Set,The_Items(Of_Index)  = 

And-.The_Se  t .  The_I  terns  { And_Index )  then 
exit; 

else 

AndLIndex  :=  AndLIndex  -  1; 
end  if; 
end  loop; 

if  AndLIndex  =  0  then 

To_The_Set.The_Iteins(To_The_Set.The_Back  +  1)  :  = 

Of_The_Set.The_Iteins(Of_Index)  ; 

To_The_Set  .The_Back  :=  To_The_Set .  The^Back  +  1; 
end  if; 
end  loop; 
exception 

when  Constraint„Error  => 
raise  Overflow; 
end  Difference; 


procedure  Remove  (The__Item  ;  in  Item; 

From_The_Set  :  in  out  Set)  is 

begin 

for  Index  in  1  . .  From_The_Set .The_Back  loop 

if  The_Item  =  From-.The_Set  .The_I terns  (Index)  then 

FronuThe_Set.The_Items(  Index  ..  (FronL_The_Set  .The_Back 

“  D)  :  = 

FronL.The_Set .The_ltems ( (Index  +  1)  .. 

Fr om_The_Set , The_Back ) ; 

FronuThe_Set.The_Back  :=  Fronu.The_Set ,The_Back  -  1; 
return; 
end  if; 
end  loop; 

raise  Item_Is_Not_InuSet; 
end  Remove; 


procedure  Union  {Of_The_Set  :  in  Set; 

And_,The_Set:  in  Set; 

To_The_Set  :  in  out  Set)  is 

Natural ; 

Natural ; 


To^Index 
To^ack 
begin 

To_The_Se t . The_I terns { 1 


Of _The_Set . The_Back )  : = 


Of_The_Set .  The_I terns  (1  . .  Of_The_Se t .  The_Back )  ; 
To_The_Set.The_Back  :=  Of_The_Set .The_Back; 
To_Back  To_The_Set .The_Back; 

for  And_Index  in  1  . .  And_The„Set .The_Back  loop 
To^Index  :=  To^Back; 
while  To_Index  >  0  loop 

if  To_The_Set.The_Items{To_Index)  = 

And_The_Set . The_Items (AndLIndex)  then 
exit; 


else 

To_Index  :=  To_Index  -  1; 
end  if; 
end  loop; 

if  To_Index  =  0  then 

To_The_Set . The_Items (To_The_Set . The_Back  + 
^d„The_Set . The_I terns  (AndLIndex)  ; 
To_The„Set .The_Back  :=  To_The_Set .The_Back 
end  if; 
end  loop; 
exception 

when  Constraint_Error  ss> 
raise  Overflow; 
end  Union; 


1)  :  = 
+  1; 


modified  by  Tucin  Nguyen 
20  Aug  95 

replacing  functions  with  procedures 


procedure  Is^Equal  (Left 

Right 
Result 

begin 

Result  :=  Is_Equal (Left, Right) ; 
end  Is_Equal; 

procedure  Extent_Of  (The_Set 

Result 

begin 

Result  :=  Extent_Of (The_Set) ; 
end  Extent_Of; 


in  Set; 
in  Set; 

out  Boolean)  is 


in  Set ; 

out  Natural)  is 


procedure  Is_Eir?3ty  {The_Set 

Result 

begin 

Result  :=  Is_Enpty(The_Set) ; 
end  Is^Empty; 


in  Set; 
out  Boolean) 


procedure  Is_AwMember 


(The_Item  ;  in  Item; 
Of_The_Set  :  in  Set; 

Result  :  out  Boolean)  is 

begin 

Result  : =  Is_A_Member ( The_I tern, Of_The_Set ) ; 
end  Is..AJMember ; 


procedure  Is^_Subset  (Left 

Right 
Result 

begin 

Result  :=  Is_A„Subset  (Left, Right)  ; 
end  Is_A_Subset; 


in  Set; 
in  Set; 

out  Boolean)  is 


procedure  Is_A_Proper_Subset  (Left  :  in  Set; 

Right  :  in  Set; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is_A_Proper_Stibset  (Left, Right )  ; 
end  Is_A_Proper_Subset; 

end  of  modification 


procedure  Intersection  (Of_The__Set  :  in  Set; 

Andjrhe^Set  :  in  Set; 

To_The_Set  :  in  out  Set)  is 


function  Is_Equal  (Left 
Right 


in  Set; 

in  Set)  return  Boolean  is 
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Right_Index  :  Natural; 
begin 

if  Left.The_Back  /=  Right .The^Back  then 
return  False; 

else 

for  Left_Index  in  1  . .  Left .The„Back  loop 
Right^Index  :=  Right .The_Back; 
while  Right_Index  >  0  loop 

if  Left.The_Items(Left_Index)  = 

Right . The_I terns (Right_Index)  then 
exit  ; 

else 

Right^Index  :=  Right_Index  -  1; 
end  if; 
end  loop; 

if  Right_,Index  =  0  then 
return  False; 
end  if; 
end  loop; 
return  True; 
end  if; 
end  Is_Equal; 

function  Extent_Of  (The_Set  :  in  Set)  return  Natural  is 
begin 

re  turn  The_Se  t . The_Back ; 
end  Extent_Of; 

function  Is^Enpty  (The^Set  :  in  Set)  return  Boolean  is 
begin 

return  (The_Set .The^Back  =0); 
end  Is^Enpty; 

fimction  Is_A^einber  (The_Itein  :  in  Item; 

Of_The_Set  :  in  Set)  return  Boolean  is 

begin 

for  Index  in  1  . .  Of_The_Set .The_Back  loop 

if  Of_The_Set.The_Items{Index)  =  The_Item  then 
return  True; 
end  if; 
end  loop; 
return  False; 
end  Is_AJdember; 

function  Is_KJSvbset  (Left  :  in  Set; 

Right  :  in  Set)  return  Boolean  is 
Right_Index  :  Natural; 
begin 


for  Left_Index  in  1  .  .  Left  .The_Back  loop 
Right_Index  :=  Right .The_Back; 
while  Right_Index  >  0  loop 

if  Left.The_Itenis(Left_Index)  = 

Right .The_I terns (Right_Index)  then 
exit  ; 

else 

Riglit_Index  ;=  Right_Index  -  1; 
end  if; 
end  loop; 

if  Right_Index  =  0  then 
return  False; 
end  if; 
end  loop; 
return  True; 
end  Is_A_Subset; 

function  Is_Av_Proper_S\abset  (Left  :  in  Set; 

Right  :  in  Set)  return  Boolean  is 

Right_Index  :  Natural; 
begin 

for  Left_Index  in  1  . .  Left .The^Back  loop 
Right_Index  :=  Right .The_Back; 
while  Right_Index  >  0  loop 

if  Left,The_Items(Left_Index)  = 

Right .  The_I  terns  ( Ri  ght_lndex )  then 
exit; 

else 

Right_Index  :=  Right_Index  -  1; 
end  if; 
end  loop; 

if  Right_Index  =  0  then 
return  False; 
end  if; 
end  loop; 

return  (Left .The_Back  <  Right. The_Back) ; 
end  Is_A„Proper_Subset; 

procedure  Iterate  {Ov€r_The_Set  :  in  Set)  is 
Continue  ;  Boolean; 
begin 

for  The_Iterator  in  1  .  .  Over_The_Set  .The_Back  loop 

Process (Over_The_Set .The_Items (The_Iterator ) ,  Continue) 
exit  when  not  Continue; 
end  loop; 
end  Iterate; 

end  Se t_Siraple_Sequential^oundedJManaged_Iterator ; 
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SET  SIMPLE  SEQUENTIAL  BOUNDED  MANAGED  ITERATOR 

PSDL 


TYPE  Set_Sin?)le_Sequential_Bounde<iJianaged^Iterator 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE^TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

From_The_Set  :  Set, 

To_The_Set  ;  Set 
OUTPUT 

To_The_Set  :  Set 
EXCEPTIONS 

Overflow,  IteirL.Is_In_Set,  ltenL,Is_Not_In_Set 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Set  :  Set 
OUTPUT 

The_Set  :  Set 
EXCEPTIONS 

Overflow,  ItenuIs_In_Set,  ItenuIs_Not_Ii;_Set 

END 

OPERATOR  Add 
SPECIFICATION 
INPUT 

The_Item  ;  Item, 

To_'Iiie_Set  :  Set 
OUTPUT 

To_The_Set  :  Set 
EXCEPTIONS 

Overflow,  IteiiL.Is_In_Set,  IteituIs_Not_Iii>_Set 

END 

OPERATOR  Remove 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

From_The_Set  :  Set 
OOTPUT 

FroirL.The_Set  :  Set 
EXCEPTIONS 

Overflow,  Item_Is_IrL_Set,  Item_Is_Not_In_Set 

END 

OPERATOR  Union 
SPECIFICATION 
INPUT 

Of__The_Set  :  Set, 

And_The_Set  :  Set, 

To_The_Set  :  Set 
OUTPUT 

To_The_Set  :  Set 
EXCEPTIONS 

Overflow,  Item_Is_In^Set,  Item_ls_Not_In_Set 

END 

OPERATOR  Intersection 
SPECIFICATION 
INPUT 

Of_The_Set  :  Set, 

And_The_Set  :  Set, 

To_The_Set  :  Set 
OUTPUT 

To_The_Set  ;  Set 
EXCEPTIONS 

Overflow,  Itein_Is_In_Set,  Item_IsJNot_In_Set 

END 

OPERATOR  Difference 
SPECIFICATION 
INPUT 

Of_The_Set  :  Set, 

AndLThe_Set  :  Set , 

To_The_Set  ;  Set 
OUTPUT 

To_The_Set  :  Set 
EXCEPTIONS 

Overflow,  Item_Is_In_Set,  Item_IsJJot_IiuSet 


END 

OPERATOR  Is^Equal 

SPECIFICATION 

INPUT 

Left  :  Set, 

Right  :  Set 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Iten\_Is„In„Set,  Iten\_Is_>Jot_In_Set 

END 

OPERATOR  Extent^Of 

SPECIFICATION 

INPUT 

The_Set  :  Set 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  lteiiuIs_In_Set,  Iten\_Is_Not_In_Set 

END 

OPERATOR  Is_En?)ty 

SPECIFICATION 

INPUT 

The_Set  :  Set 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  IteirL.Is_In_Set,  Item_Is_Not_ln_Set 

END 

OPERATOR  Is^AwNeniber 

SPECIFICATION 

INPUT 

The_Item  :  Item, 

Of_The_Set  :  Set 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Item^Is_In_Set,  IteiruIs_Not_In„Set 

END 

OPERATOR  IS_A-Subset 

SPECIFICATION 

INPUT 

Left  :  Set, 

Right  :  Set 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  ItenuIs_In„Set,  Item_Is_Not_In_Set 

END 


OPERATOR  Is_A-Proper_Subset 

SPECIFICATION 

INPUT 

Left  :  Set, 

Right  :  Set 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  ItenuIs_IrL.Set,  Item_IsJJot_In_Set 

END 

OPERATOR  Iterate 

SPECIFICATION 

GENERIC 

Process  :  PROCEDURE [The_I tern  :  intt  ;  Item],  Continue  :  out[t 
Boolean] ] 

INPUT 

Over_The_Set  :  Set 
EXCEPTIONS 

Overflow,  IteituIs_In_Set,  Item_Is_Not_In_Set 

END 

END 

IMPLEMENTATION  ADA  Set_Si»5>le_Sequential_Bounded^anaged_Iterator 
END 
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SET  SIMPLE  SEQUENTIAL  BOUNDED  MANAGED  NONITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

package  Set_Siitple_Sequential_Bo\mded_Managed_Noniterator  is 
type  Set(The_Size  :  Positive)  is  limited  private; 


procedure 

Copy 

(From_The_Set 

in 

Set; 

To_The_Set 

in 

out 

Set)  ; 

procedure 

Clear 

(The_Set 

in 

out 

Set) ; 

procedure 

Add 

(The_Item 

in 

I  tern; 

To_The_Set 

in 

out 

Set)  ; 

procedure 

Remove 

(The_Item 

in 

Item; 

Fr  om_The_Se  t 

in 

out 

Set)  ; 

procedure 

Union 

(Of_The_Set 

in 

Set; 

And_The_Set 

in 

Set; 

To_,The_Set 

in 

out 

Set)  ; 

procedure 

Intersection 

{Of_The_Set 

in 

Set; 

And_The_Set 

in 

Set; 

To_The_Set 

in 

out 

Set)  ; 

procedure 

Difference 

(Of_The_Set 

in 

Set; 

And_The_Set 

in 

Set; 

To_The_Set 

in 

out 

Set)  ; 

modified  by  Tuain  Nguyen 

20  Aug  95 

replacing 

functions  with  procedures 

procedure 

Is_Equal 

(Left 

in 

Set; 

Right 

in 

Set; 

Result 

out  Boolean) 

procedure 

Extent_Of 

(The^Set 

in 

Set; 

Result 

out  Natural) 

procedure 

Is_En5>ty 

{The_Set 

in 

Set; 

Result 

out  Boolean) 

procedure  Is,J01einber 

{The„Item 

;  in  Item; 

Of_The_Set 

:  in  Set ; 

Result 

:  out  Boolean) ; 

procedure  Is^A^Siabset 

(Left 

;  in  Set; 

Right 

:  in  Set ; 

Result 

;  out  Boolean) ; 

procedure  Is^A^Proper_Subset 

(Left 

:  in  Set ; 

Right 

;  in  Set; 

Result 

:  out  Boolean) ; 

end  of  modification 

function  Is_Equal 

(Left  : 

in  Set; 

Right  : 

in  Set)  return  Boolean 

function  Extent_Of 

(The^Set  : 

in  Set)  return  Natural 

function  Is_Ett?jty 

(The^Set  : 

in  Set)  return  Boolean 

function  Is_A^eniber 

(The_Item  : 

in  Item; 

Of_The„Set  : 

in  Set)  return  Boolecin 

function  Is_^Subset 

(Left  : 

in  Set; 

Right  : 

in  Set)  return  Booleeui 

f\mction  Is_A_Proper_Subset 

(Left  : 

in  Set; 

Right  : 

in  Set)  return  Boolean 

Overflow  :  exception; 

Itern_Is_In_Set  :  exception; 

Item_IsJNot_In_Set  :  exception; 

private 

type  Items  is  array ( Positive  range  <>)  of  Item; 
type  Set (The_Size  :  Positive)  is 
record 

The^Back  :  Natural  ;=  0; 

The_I terns  :  Items  {1  ..  The_Size)  ; 
end  record; 

end  Set_Siinple_Sequential_Boundecijaanaged_Noni terator ; 
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SET  SIMPLE  SEQUENTIAL  BOUNDED  MANAGED  NONITERATOR 

ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 


—  Serial  Kximber  0100219 

"Restricted  Rights  Legend" 

Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  sxabdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Computer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body  Set_Siinple_Sequential_Bounded.JlanagedJNoniterator  is 

procedure  Copy  (FronL_The_Set  :  in  Set; 

To_The_Set  :  in  out  Set)  is 

begin 

if  FronuThe_Set.The_Back  >  To_The_Set .The_Size  then 
raise  Overflow; 

else 

To_The_Set.The_ltems(l  ..  FronuThe_Set . The_Back)  :  = 
FronuThe^Se t .  The_I terns  ( 1  - .  Fr osL-The^Se  t .  The_Back )  ; 
To_The_Set.The_Back  :=  FronL_The_Set .The_Back; 
end  if; 
end  Copy; 

procedure  Clear  (The_Set  :  in  out  Set)  is 
begin 

The_Set .The_Back  :=  0; 
end  Clear; 


procedure  Add  (The^Item  :  in  I tern; 

To_The_Set  :  in  out  Set)  is 

begin 

for  Index  in  1  . .  To_The_Set .The_Back  loop 

if  The_Item  ss  To_The_Set.The_I terns  (Index)  then 
raise  IteiiuIs_ln^Set; 
end  if; 
end  loop; 

To_The_Se t.The_I terns {To_The_Set.The_Back  +1)  :=  The_Item; 

To_The_Set.The_Back  ;=  To_The_Set .TheJBack  +  1; 
exception 

when  Cons t rain t^Error  ®> 
raise  Overflow; 

end  Add; 


procedure  Remove  {The_Item  :  in  Item; 

From_The„Set  :  in  out  Set)  is 

begin 

for  Index  in  1  . .  FronuThe_Set  .The_Back  loop 

if  The_Item  =  FroiiuThe_Set.The_I terns  (Index)  then 

From_The_Se  t .  The_I  terns  ( Index  . .  ( FroxtuThe_Set .  The_Back 

-  D)  :  = 

From_The_Set .The_I terns ( (Index  +1)  .. 

FroiiuThe_Set.The_Back)  ; 

Froiii_The_Set  .The_Back  ;=  From_The_Set  .The_Back  -  1; 
return; 
end  if; 
end  loop; 

raise  Item_Is_Mot_In_Set; 
end  Remove; 


procedure  Union  (Of_The_Set  :  in  Set; 

AncL.The_Set :  in  Set; 

To_The_Set  :  in  out  Set)  is 

To_Index  ;  Natural; 

To_Back  :  Natural ; 
begin 

To_The_Se t.The_I terns (1  ..  Of_The_Set .The_Back)  :  = 
Of_The_Set  .The_Items  (1  . .  Of_The_Set  .The^ack) ; 
To_The_Set.The_Back  Of_The_Set ,The_Back; 
To_Back  :=  To_The_Set .The^Back; 
for  And^Index  in  1  . .  And_The_Set  .The_Back  loop 
To_Index  :=  To_Back; 
while  To_Index  >  0  loop 

if  To_The_Set.The_Items(To_Index)  * 

AndLThe_Se t .  The_I  terns  ( And_Index )  then 
exit; 


else 

To_Index  :=  To_Index  -  1; 
end  if; 
end  loop; 

if  To^Index  =  0  then 

To_The_Set.The_Items(To_The_Set.The_Back  +1)  ;  = 

AncLThe_Set  .The_l terns  (And_lndex) ; 
To_The_Set.The_Back  :=  To_The_Set .The_Back  +  1; 
end  if; 
end  loop; 
exception 

when  Cons train t_Err or  => 
raise  Overflow; 
end  Union; 


procedure  Intersection  (Of_The_Set  :  in  Set; 

And_The_Set  ;  in  Set; 

To_The_Set  :  in  out  Set)  is 


And_Index  :  Natural; 
begin 

To_The_Set.The_Back  :=  0; 

for  Of_Index  in  1  . .  Of_The_Set .The_Back  loop 
AndLIndex  :=  And^The_Set  .The_Back; 
while  AndLIndex  >  0  loop 

i  f  0  f _The_Se  t .  The_I  terns  ( Of _Index )  = 

And_The_Set  .The_Items  (AndLIndex)  then 
To_The„Set .The_I terns (To_The_Set.The_Back  +  1) 
Of  jrhe_Set .  The_I terns  { Of_Index )  ; 

To_The_Set .The_Back  :=  To„The_Set .The_Back  +  l 
exit; 

else 

AndLIndex  :=  AndLIndex  -  1; 
end  if; 
end  loop; 
end  loop; 
exception 

when  Constraint_Error  => 
raise  Overflow; 
end  Intersection; 

procedure  Difference  {Of_The_Set  ;  in  Set; 

And_The_Set  :  in  Set; 

To_The_Set  ;  in  out  Set)  is 

AndLIndex  ;  Natural; 
begin 

To_The_Set . The_Back  : =  0 ; 

for  Of_Index  in  1  . .  Of_The_Set .The_Back  loop 
AndLIndex  : =  AndLThe_Set . The_Back ; 
while  And_lndex  >  0  loop 

i f  Of _The_Se t . The_I terns ( Of _Index)  = 

AndLThe_Se  t . The_I terns (AndLIndex )  then 
exit; 

else 

AndLIndex  :=  And_Index  -  1; 
end  if; 
end  loop; 

if  AndLIndex  =  0  then 

To_The_Set.The_Items (To_The_Set.The_Back  +1)  := 

0  f _The_Se  t . The_I terns ( 0 f _Index ) ; 
To_The_Set.The_Back  :=  To_The_Set . The_Back  +  1; 
end  if; 
end  loop; 
exception 

when  Cons  t rain t_.Err or  => 
raise  Overflow; 
end  Difference; 

modified  by  Tuan  Nguyen 
20  Aug  95 

replacing  f^anctions  with  procedures 


procedure  Is_Equal  (Left 

Right 
Result 

begin 

Result  :=  Is_Equal (Left, Right) ; 
end  Is_Equal; 

procedure  Extent^Of  (The_Set 

Result 

begin 

Result  :=  Extent_Of (The_Set ) ; 
end  Extent^Of; 

procedure  Is_Empty  (The_Set 

Result 

begin 

Result  ;=  Is^Empty (The_Set) ; 
end  Is_Ertpty; 


in  Set; 
in  Set; 

out  Boolean)  is 


in  Set; 

out  Natural)  is 


in  Set; 

out  Boolean)  is 


procedure  Is_A_^leinber  (The_Item  :  in  Item; 

Ofjrhe_Set  :  in  Set; 

Result  :  out  Boolean)  is 

begin 

Result  :  =  Is_A_Meinber  ( The_I tern,  Of_The_Set ) ; 
end  Is^_Member; 


procedure  Is^_Subset  (Left 

Right 
Result 

begin 

Result  ;=  Is_A.^Subset  (Left,  Right) ; 
end  Is_A_Sxibset ; 


in  Set; 
in  Set; 

out  Boolean)  is 


procedure  Is_A_Pi‘opei^-.Subset 


(Left 

Right 

Result 


in  Set; 
in  Set; 
out  Boolean) 


begin 

Result  :  =  Is.JL.Proper_Subset  (Left,  Right) ; 
end  Is_A^Proper_Subset  ; 


is 


end  of  modification 


function  Is_Equal  (Left 
Right 


in  Set; 

in  Set)  return  Boolean  is 
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Right^Index  :  Natural; 
begin 

if  Left.The^Back  /=  Right .The_Back  then 
return  False; 

else 

for  Left_lndex  in  1  . .  Left .The_Back  loop 
Right_Index  :=  Right ,The_Back; 
while  Right^Index  >  0  loop 

if  Le ft.The_I terns (Left_Index)  = 

Right . The_I terns (Right_Index)  then 
exit  ; 

else 

Right_Index  :=  Right_Index  -  1; 
end  if; 
end  loop; 

if  Right_Index  =  0  then 
return  False; 
end  if; 
end  loop; 
return  True; 
end  if; 
end  Is_Equal; 

function  Extent_Of  {The_Set  :  in  Set)  return  Natural  is 
begin 

return  The_Se  t . The_Back ; 
end  Extent_Of; 

function  Is_Empty  (The^Set  ;  in  Set)  return  Boolean  is 
begin 

return  (The_Set .The_Back  =  0); 
end  Is_En5)ty; 

function  Is^AJlember  (The_Itein  :  in  Item; 

Of_The_Set  ;  in  Set)  return  Boolean  is 

begin 

for  Index  in  1  . .  Of_The_Set .The_Back  loop 

if  Of_The_Set-The_I terns  (Index)  =  The_Item  then 
return  True; 
end  if; 
end  loop; 
return  False; 
end  Is.AJMeinber; 


function  Is_A_Subset  (Left  :  in  Set; 

Right  :  in  Set)  return  Boolean  is 
Right_Index  :  Natural; 
begin 

for  Left^Index  in  1  . .  Left .The_Back  loop 
Right_Index  : =  Right . The_Back ; 
while  Right^Index  >  0  loop 

if  Left.The_Iteins{Left_Index)  = 

Right . The_I terns ( Righ t_Index )  then 
exit; 

else 

Right_Index  :=  Right_Index  -  1; 
end  if; 
end  loop; 

if  Right_Index  =  0  then 
return  False; 
end  if; 
end  loop; 
return  True; 
end  Is^_Subset; 

function  Is_A_Pi^oper_Subset  (Left  :  in  Set; 

Right  :  in  Set)  return  Boolean  is 

Right_Index  :  Natural; 
begin 

for  Left_Index  in  1  - •  Lef t .The_Back  loop 
Right_Index  :=  Right , The_Back ; 
while  Right_Index  >  0  loop 

if  Left.The_Items(Left_Index)  = 

Right . The_I terns ( Righ t_Index )  then 
exit; 

else 

Right^Index  Right_Index  -  1; 
end  if; 
end  loop; 

if  Right_Index  =  0  then 
return  False; 
end  if; 
end  loop; 

return  (Left .The_Back  <  Right .The_Back) ; 
end  Is_A-.Proper_Subset ; 

end  Set_Simple_Sequential_Bounded_>!anaged_Noniterator ; 


214 


SET  SIMPLE  SEQUENTIAL  BOUNDED  MANAGED  NONITERATOR 

PSDL 


TYPE  Set_Sin?}le_Sequent ial_BoundecLManagedJJoni  terator 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

FrortuThe_Set  :  Set, 

To_The_Set  :  Set 
OUTPUT 

To_The_Set  :  Set 
EXCEPTIONS 

Overflow,  IteiiuIs_In_Set,  Iten:uIsjNot_In_Set 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Set  :  Set 
OUTPUT 

The_Set  :  Set 
EXCEPTIONS 

Overflow,  Iteir\_ls_In_Set,  ItenuIs_Not_In_Set 

END 

OPERATOR  Add 
SPECIFICATION 
INPUT 

The_Item  ;  Item, 

To_The_Set  :  Set 
OUTPUT 

To_The_Set  :  Set 
EXCEPTIONS 

Overflow,  Iteir^Is_In_Set,  IteituIs_Not_In_Set 

END 

OPERATOR  Remove 
SPECIFICATION 
INPUT 

The_Item  ;  Item, 

FronuThe_Set  ;  Set 
OUTPUT 

Fronu‘I^e_Set  :  Set 
EXCEPTIONS 

Overflow,  Item_Is_In_Set,  IteiruIs_Not_In_Set 

END 

OPERATOR  Union 
SPECIFICATION 
INPUT 

Of_The_Set  :  Set, 

And_The_Set  :  Set, 

To_The_Set  ;  Set 
OUTPUT 

To_The_Set  :  Set 
EXCEPTIONS 

Overflow,  Item_ls_ln_Set,  IteiiuIs_Not_In_Set 

END 

OPERATOR  Intersection 
SPECIFICATION 
INPUT 

Of_The_Set  ;  Set, 

And_The_Set  ;  Set, 

To_The_Set  :  Set 
OUTPUT 

To_The_Set  :  Set 
EXCEPTIONS 

Overflow,  Item_Is_In_Set,  Itenu,IsJNot_In_Set 

END 

OPERATOR  Difference 
SPECIFICATION 
INPUT 

Of_The_Set  :  Set, 


And_The_Set  :  Set, 

To_The_Set  :  Set 
OUTPUT 

To_The_Set  :  Set 
EXCEPTIONS 

Overflow,  ItenuIs_In_Set,  ItenuIs_Not  In_Set 

END 

OPERATOR  Is_Equal 

SPECIFICATION 

INPUT 

Left  :  Set, 

Right  :  Set 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  IteitL.Is_In_Set,  Item_Is_Not_In_Set 

END 

OPERATOR  Extent_Of 

SPECIFICATION 

INPUT 

The^Set  :  Set 
OUTPUT 

Result  ;  Natural 
EXCEPTIONS 

Overflow,  Item_ls_In_Set,  Item_Is_Not_In_Set 

END 

OPERATOR  Is_^En5)ty 

SPECIFICATION 

INPUT 

The_Set  ;  Set 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  ItenuIS-In_Set ,  Iten\_Is_Not_In_Set 

END 


OPERATOR  Is_AJ4ember 

SPECIFICATION 

INPUT 

The^Item  :  Item, 

Of_The_Set  :  Set 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Item_ls_In_Set,  Item_lsJNot_in_Set 

END 

OPERATOR  Is^A^Subset 

SPECIFICATION 

INPUT 

Left  :  Set, 

Right  :  Set 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  ItetruIs_In_Set,  IteituIs_Not„ln_Set 

END 

OPERATOR  Is_A_Proper_Subset 

SPECIFICATION 

INPUT 

Left  ;  Set, 

Right  ;  Set 
OUTPOT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  lteiiuIs_In_Set,  Item_IsJNot_In_Set 

END 

END 

IMPLEMENTATION  ADA  Set_Simple_Sequential_Bounded_Managed_Noniterator 
END 
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SET  SIMPLE  SEQUENTIAL  UNBOUNDED  MANAGED  ITERATOR 

ADA  SPECIFICATIONS 


generic 

packaS^SeSi^lSe^«ntial_UnboundedJIanaged_Iterator  is 
type  Set  is  limited  private; 


procedure  Copy 

procedure  Clear 
procedure  Add 

procedure  Remove 

procedure  Union 


procedure  Intersection 


procedure  Difference 


(FronuThe_Set 
To_The_Set 
(The^Set 
(The_Item 
To_The_Set 
(The_Item 
Fr  on\_The_Se  t 
(Of_The_Set 
And_The_Set 
To_The_Set 
(Of_The_Set 
And_The_Set 
To_The_Set 
(Of_The_Set 
And^The_Set 
To_The_Set 


—  modified  by  Tuan  Nguyen 

—  20  Aug  95  , 

—  replacing  f junctions  with  procedures 


procedure  Is^Equal 

procedure  Extent^Of 
procedure  Is_Empty 
procedure  ls,,JV_Nember 


(Left 

Right 

Result 

(The_Set 

Result 

{The_Set 

Result 


:  in  Set; 

:  in  Set; 

:  out  Boolean) ; 
;  in  Set ; 

:  out  Natural) ; 
:  in  Set; 

:  out  Boolean) ; 


Of_The_Set 

Result 

procedure  Is^_Subset  (Left 

Rrght 
Result 

procedure  ls_A^Proper_Subset  (Left 
Right 
Result 


—  end  of  modification 

function  Is^Equal 

function  Extent_Of 
function  Is_Errpty 
function  Is^Member 

function  ls_A-.Subset 

function  Is_A_Proper_SubS€t 


(Left 

Right 

(The_Set 

(The_Set 

(The_Item 

Of_The_Set 

(Left 

Right 

(Left 

Right 


in  Set; 
out  Boolean) ; 
in  Set; 
in  Set; 
out  Boolean) ; 
in  Set; 
in  Set; 
out  Boolean) ; 


in  Set; 
in  Set) 
in  Set) 
in  Set) 
in  Item; 
in  Set) 
in  Set; 
in  Set) 
in  Set; 
in  Set) 


return  Boolean; 
return  Natural; 
return  Boolean; 

return  Boolean; 

return  Boolean; 

return  Booleaui; 


^  with  procedure  Process  (The_Item  :  in  Item; 

Continue  :  out  Boolean) ; 
procedure  Iterate  {Over_The_Set  :  in  Set) ; 

Overflow  :  exception; 

ItenuIs_In_Set  :  exception; 

IteiiuIs_Not_In_Set  :  exception; 

private 

type  Node; 

type  Set  is  access  Node; 

end  Se t_Sitnple_Sequent ial_Unbounded_Managed_I  tera tor ; 
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SET  SIMPLE  SEQUENTIAL  UNBOUNDED  MANAGED  ITERATOR 


ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3}  (ii) 

—  of  the  rights  in  Technical  Data  and  Conputer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

with  Storage_Manager_Sequential; 

package  body  Set_Sin5>le_Sequential_Unbounded_ManagedLIterator  is 

type  Node  is 
record 

The_I  tern  :  1 1  em  ; 

Next  :  Set; 
end  record; 

procedure  Free  (The_Node  :  in  out  Node)  is 
begin 

null ; 
end  Free; 

procedure  SetJNext  (TheJTode  :  in  out  Node; 

ToJWext  ;  in  Set)  is 

begin 

The JMode .  Nex  t  :  =  To_Next ; 
end  Set_^ext; 

function  Next_Of  (TheJNode  :  in  Node)  return  Set  is 
begin 

return  The^ode .Next; 
end  Next_Of  ; 

package  Node_Manager  is  new  Storage_Jlanager_Sequential 

(Item  =>  Node, 

Pointer  =>  Set, 

Free  ->  Free, 

Set_Pointer  ==>  Set_Next, 
Pointer^Of  =>  Next_Of ) ; 

procedure  Copy  ( From_The_Set  :  in  Set; 

To_The_Set  :  in  out  Set)  is 
From_Index  :  Set  :=  From_The_Set ; 

To^Index  :  Set ; 
begin 

Node JManager. Free (To_The_Set) ; 
if  From_The_Set  /==  null  then 

To_The_Set  :=  Node_Manager.New_Item; 

To_The_Set .The_Item  ;=  Froitu index. The_I tern; 

To^Index  :=  To_The_Set; 

Fr onulndex  :  =  From^Index .  Next  ; 
while  From_Index  /-  null  loop 

To_Index.Next  :=  NodeJManager .New_Item; 

To_.Index  :=  To_Index.Next ; 

To_Index.The_Item  :=  From_Index.The_Item; 
From_Index  :=  From_Index.Next; 
end  loop; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Copy; 

procedure  Clear  (The^Set  :  in  out  Set)  is 
begin 

Node_Manager .  Free  (The_Set )  ; 
end  Clear; 

procedure  Add  (The_Item  :  in  I tern; 

To_The_Set  ;  in  out  Set)  is 
Tenqporary JMode  :  Set ; 

Index  :  Set  :=  To_The„Set; 

begin 

while  Index  /=  null  loop 

if  Index. The_I tern  =  The_Item  then 
raise  Item_Is_In_Set ; 

else 

Index  ;=  Index. Next; 
end  if; 
end  loop; 

Temporary  JMode  :=  NodeJManager  .New_I  tern; 

TenporaryJIode  .The_Item  :=  The_Item; 

Tenporaxry^Node .  Next  :  =  To„The_Set  ; 

Tojrhe_Set  Tenporary^Node ; 
exception 

when  Storage_Error  => 
raise  Overflow; 

end  Add; 

procedure  Remove  (The_Item  :  in  I tern; 

From_The_Set  :  in  out  Set)  is 
Previous  :  Set; 


Index  :  Set  ;=  FronuThe^Set ; 
begin 

while  Index  /=  null  loop 

if  Index. The_I tern  =  The_Item  then 
if  Previous  =  null  then 

FroirL_The_Se  t  :  =  FronuThe_Se t .  Next  ; 

else 

Previous . Next  ; =  Index . Next ; 
end  if; 

Index . Next  ; =  nul 1 ; 

Node Jlanager .  Free  { Index ) ; 
return; 

else 

Previous  :=  Index; 

Index  :=  Index, Next; 
end  if; 
end  loop; 

raise  IteiA_Is_Not_In_Set; 
end  Remove; 

procedure  Union  {Of_The_Set  :  in  Set; 

Anc3LThe_Set:  in  Set; 

To_The_Set  :  in  out  Set)  is 

Fronjlndex  :  Set  :=  Of_The_Set; 

To_Index  :  Set ; 

To^Top  :  Set; 

Tenporary_^ode  :  Set; 

begin 

Node_Manager . Free {To_The_Set ) ; 
while  From_Index  /=  null  loop 

Teinporary_JJode  :=  Node_Maiiager.New_Item; 
Tenporary_Node.The_Item  ;=  From_Index.The_Item; 
Tenporary_Node .  Next  :  =  To_The_Se  t  ; 

To_The_Set  :  =  Tenporary_jJode ; 

From_Index  FronjIndex.Next ; 
end  loop; 

FroDL-Index  :  =  And_The_Set ; 

To_Top  :=  To_The_Set; 
while  From_Index  /=  null  loop 
To_Index  To_Top; 
while  To_Index  /=  null  loop 

if  FronuIndex.The_Item  *  To_Index.The_Item  then 
exit  ; 

else 

To_Index  :  =  To^Index . Next ; 
end  if; 
end  loop; 

if  To_Index  =  null  then 

Tenporary__Node  :=  Node_Manager.New_Item; 
Teirporary_Node  .The^Item  ;=  From_Index.The_Item; 
Teaporary^Node.Next  :=  To_The_Set; 

To_The_Set  :=  Tenpor  ary  JMode  ; 
end  if; 

Frortuindex  ;=  Froin_Index.Next ; 
end  loop; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Union; 

procedure  Intersection  (Of_The_Set  :  in  Set; 

And_The_Set  :  in  Set; 

To_The„Set  :  in  out  Set)  is 

Of_Index  :  Set  :=  Of_The_Set; 

And_Index  :  Set; 

Tenporary  JMode  ;  Set ; 
begin 

NodeJManager .  Free  (To_ThejSet ) ; 
while  Ofjindex  /=  null  loop 
And_Index  :=  AncJThejSet; 
while  Andjlndex  /-  null  loop 

if  Of_Index.The_Item  =  AncLIndex,The_Item  then 
TenporaiY-Node  :=  Node_Manager  .New^Item; 
Tenporaryj,Node.The_ltem  :=  Of jlndex-ThCjItem; 
TenporaryjNode.Next  :=  To^The^Set; 

To_The_Set  ;=  Tenpor ary_Node ; 
exit ; 

else 

Andjlndex  :=  AndjIndex.Next; 
end  if; 
end  loop; 

Ofjindex  :=  Of jIndex.Next; 
end  loop; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Intersection; 

procedure  Difference  {Of_ThejSet  ;  in  Set; 

AnoLThe_Set  :  in  Set; 

To_The_Set  :  in  out  Set)  is 

Ofjindex  :  Set  :=  OfjThe_Set; 

And-Index  ;  Set; 

Temporary  JMode  :  Set; 

begin 

Node_Manager . Free ( To jThe_Se t ) ; 
while  Of_Index  /=  null  loop 
Andjindex  : =  And_ThejSet ; 
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while  And_Index  /*  null  loop 

if  Of_Index.The_Item  =  And_Index.The_Item  then 
exit; 

else 

And_Index  :=  And_Index.Next 
end  if; 
end  loop; 

if  AncLIndex  =  null  then 

Tenporary^Node  :=  Node_Manager .New_Item; 
Ten^)orary_Node.The_Item  :=  Of_Index.The_Item; 
Temper ary_Node. Next  :=  To_The_Set; 

To_The_Set  :=  Tenpor aryJNode ; 
end  if; 

Of^Index  :=  Of_Index.Next; 
end  loop; 
exception 

when  storage_Error  => 
raise  Overflow; 
end  Difference; 

modified  by  Tuan  Nguyen 
20  Aug  95 

replacing  functions  with  procedures 


procedure  Is^Equal  (Left 

Right 
Result 

begin 

Result  :=  Is^Equal (Left, Right) ; 
end  Is^Equal; 

procedure  Extent_0f  (The_Set 

Result 

begin 

Result  :=  Extent^Of (The^Set) ; 
end  Extent_Of; 

procedure  Is_Empty  (The^Set 

Result 

begin 

Result  :=  Is_Eropty(The_Set) ; 
end  Is^Empty; 


procedure  Extent_0f 


procedure  Is_Empty 


in  Set; 
in  Set; 

out  Booleeui)  is 


in  Set; 

out  Natural )  is 


in  Set; 

out  Boolean)  is 


procedure  Is_A^ember  (The_ltem  :  in  I 

Of_The_Set  :  in  S 
Result  :  out 

begin 

Result  :  =  Is.J^Meniber  { The_I tem,  Of_The_Set )  ; 
end  Is^_Nember; 


in  I  tern; 
in  Set; 

out  Boolean)  is 


procedure  Is^^Subset  (Left 

Right 
Result 

begin 

Result  ;=  ls_A_Subset (Left, Right ) ; 
end  Is_A„Subset; 


:  in  Set; 

;  in  Set; 

:  out  Boolean)  is 


procedure  Is.,„AwP^®P®^— (Left  in 

Right  :  in 

Result  :  ovi 

begin 

Result  ;=  Is,JUProper_Subset  (Left, Right)  ; 
end  Is_A^Proper_Subset ; 

end  of  modification 


in  Set; 
in  Set; 

out  Boolean)  is 


function  Is_Equal  (Left  :  in  Set; 

Right  ;  in  Set)  return  Boolean  is 
Left_Count  :  Natural  :=  0; 

Right_Count  :  Natural  :=  0; 

Left_Index  :  Set  :=  Left; 

Right_Index  :  Set; 
begin 

while  L€ft_Index  J-  null  loop 
Right_Index  : =  Right ; 
while  Right^Index  /=  null  loop 

if  Left_Index,The_Item  =  Right_Index,The_Item  then 
exit  ; 

else 

Right^Index  :=  Right_Index . Next ; 
end  if; 
end  loop; 

if  Right^Index  =  null  then 
return  False; 

else 

Left_Count  :=  Left_Count  +  1; 

Left_Index  :=  Left_Index,Next ; 
end  if; 
end  loop; 

Right_Index  :=  Right; 

while  Right_Index  /=  null  loop 

Right_Count  :=  Right^Count  +  1; 

Right_Index  ;=  Right^Index.Next ; 
end  loop; 

return  (Left^Count  =  Right_Coiint )  ; 
end  ls_Egual; 


function  Extent^Of  (The^Set  :  in  Set)  return  Natural  is 
Count  :  Natural  :=  0; 

Index  :  Set  :=  The^Set; 

begin 

while  Index  /=  null  loop 
Count  :=  Count  +  1; 

Index  ;=  Index. Next; 
end  loop; 
return  Count; 
end  Extent_Of; 

function  Is_Eir?Jty  (The^Set  :  in  Set)  return  Boolean  is 
begin 

return  (The_Set  =  null) ; 
end  Is_En)pty; 

function  Is_A_Member  (The_Item  :  in  I  tern; 

Of_The_Set  :  in  Set)  return  Boolean  is 
Index  :  Set  Of_The_Set; 
begin 

while  Index  /=  null  loop 

if  The_Item  =  Index. The.Item  then 
return  True; 
end  if; 

Index  :=  Index. Next; 
end  loop; 
return  False; 
end  Is_AJMte»beJ^; 

function  Is^Subset  (Left  :  in  Set; 

Right  :  in  Set)  return  Boolean  as 
Left^Index  :  Set  :=  Left; 

Right^Index  :  Set; 
begin 

while  Left_Index  /=  null  loop 
Right^Index  :=  Right; 
while  Right_lndex  /=  null  loop 

if  Left_Index.The_Item  =  Right_lndex.The_Item  then 
exit; 

else 

Right_Index  :=  Right_Index.Next ; 
end  if; 
end  loop; 

if  Right_Index  =  null  then 
return  False; 

else 

Left_Index  :=  Left_Index.Next ; 
end  if; 
end  loop; 
return  True; 
end  Is,^A-.Subset ; 


ftanction  Is_A_Proper_Subset 


(Left  :  in  Set; 

Right  :  in  Set)  return  Boolean  is 


Left_Count  :  Natural  :=  0; 

Right^Count  :  Natural  :=  0; 

Left_Index  :  Set  :=  Left; 

Right_Index  :  Set; 

begin 

while  Left_Index  /=  null  loop 
Right_Index  ;=  Right; 
while  Right_lndex  {-  null  loop 

if  Left_Index.The_Item  =  Right_Index.The_Item  then 
exit; 


else 

Right_lndex  :=  Right_Index.Next ; 
end  if; 


end  loop; 

if  Right_Index  -  null  then 
return  False; 


else 

Left_Count  :=  Left_Coxant  +  1; 
Left_Index  :=  Left_Index.Next ; 


end  if; 


end  loop; 

Right_Index  ;=  Right; 

while  Right_Index  /=  null  loop 

Right_Count  ;=  Right_Count  1; 
Right^Index  :=  Right_Index.Next; 
end  loop; 

return  (Left_Count  <  Right_Count) ; 
end  Is_A^Proper_Subset ; 


procedure  Iterate  {Over_The_Set  :  in  Set)  is 
The^Iterator  :  Set  :=  Over„The_Set ; 

Continue  :  Boolean; 

begin 

while  The^Iterator  /=  null  loop 

Process (The_Iterator.The_Item,  Continue) ; 
exit  when  not  Continue; 

The_Iterator  ;=  The_I tera tor .Next ; 
end  loop; 
end  Iterate; 


end  Set_Siirple_Sequential_Unbovinded_JManaged_lterator ; 
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SET  SIMPLE  SEQUENTIAL  UNBOUNDED  MANAGED  ITERATOR 

PSDL 


TYPE  Set_Siii?)le_Se(3uential_UnbOTandecLflanage<3Llterator 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE^TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

From_The_Set  :  Set, 

To_The_Set  :  Set 
OUTPUT 

To_The_Set  :  Set 
EXCEPTIONS 

Overflow,  Item_Is_In_Set,  Item_ls_JJot_In_Set 

END 


OPERATOR  Clear 

SPECIFICATION 

INPUT 

The^Set  :  Set 
OUTPUT 

The^Set  :  Set 
EXCEPTIONS 

Overflow,  Itenuls_ln_Set,  ItertuIsJJot__In_Set 

END 

OPERATOR  Add 

SPECIFICATION 

INPUT 

The_Itein  :  Item, 

To_The_Set  :  Set 
OUTPUT 

To_The_Set  ;  Set 
EXCEPTIONS 

Overflow,  Iteit\^Is_In_Set,  IterrL.Is^Not_In_Set 

END 

OPERATOR  Remove 

SPECIFICATION 

INPUT 

The_Item  :  Item, 

Fromjrhe_Set  :  Set 
OUTPUT 

FrorruThe_Set  :  Set 
EXCEPTIONS 

Overflow,  IteitL.Is_In_Set,  Iteit\_Is_Not_In_Set 

END 

OPERATOR  Union 

SPECIFICATION 

INPUT 

Of_The_Set  :  Set, 

AncLThe_Set  :  Set , 

To_The_Set  ;  Set 
OUTPUT 

To_The_Set  ;  Set 
EXCEPTIONS 

Overflow,  Item^Is„In_Set,  Iteit\_Is_Not_In_Set 

END 

OPERATOR  Intersection 

SPECIFICATION 

INPUT 

Of_The_Set  :  Set, 

And_The_Set  :  Set , 

To_The_Set  :  Set 
OUTPUT 

To_The_Set  :  Set 
EXCEPTIONS 

Overflow,  Item_Is_In_Set,  Iteit^_Is_JNot_In_Set 

END 

OPERATOR  Difference 

SPECIFICATION 

INPUT 

Of_The_Set  :  Set, 

And_The_Set  :  Set, 

To_The_Set  :  Set 
OUTPUT 

To_The_Set  :  Set 
EXCEPTIONS 

Overflow,  Itert^_Is_In_Set,  IteIt^_Is_Not_ln_Set 


END 

OPERATOR  Is_Equal 

SPECIFICATION 

INPUT 

Left  ;  Set, 

Right  :  Set 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Item_Is_In_Set ,  Item_IsJIot_In_Set 

END 

OPERATOR  Extent_Of 

SPECIFICATION 

INPUT 

The_Set  :  Set 
OUTPUT 

Result  ;  Natural 
EXCEPTIONS 

Overflow,  ItenL.Is_In_Set ,  ItenuIsJNot_In_Set 

END 

OPERATOR  IS_Enipty 

SPECIFICATION 

INPUT 

The_Set  :  Set 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Item_Is_In_Set,  Iten\_Is_Not_In_Set 

END 


OPERATOR  Is_A-Member 

SPECIFICATION 

INPUT 

The_Item  :  Item, 

Of_The_Set  :  Set 
OUTPUT 

Result  ;  Boolean 
EXCEPTIONS 

Overflow,  Itenuls_ln„Set ,  Item_Is_Not_ln_Set 

END 

OPERATOR  IS^Subset 

SPECIFICATION 

INPUT 

Left  ;  Set, 

Right  :  Set 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Item_Is_In_Set,  Item_ls_Not_In_Set 

END 

OPERATOR  Is_A_Proper_Stibset 

SPECIFICATION 

INPUT 

Left  ;  Set, 

Right  :  Set 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Item_Is_In_Set,  Item_is_Not_In_Set 

END 

OPERATOR  Iterate 

SPECIFICATION 

GENERIC 

Process  :  PROCEDURE [The_ltem  :  intt  :  Item),  Continue  :  out[t  : 
Booleeui]  ] 

INPUT 

Over_The_Set  ;  Set 
EXCEPTIONS 

Overflow,  Item_Is_In_Set,  Item_IsJJot_In^Set 

END 

END 

IMPLEMENTATION  ADA  Set_SiiT?>le_Sequential_Unbounded_J4anaged_Iterator 
END 
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SET  SIMPLE  SEQUENTIAL  UNBOUNDED  MANAGED  NONITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

package  Set_Simple_Sequential_Unboundec3LManage<i_Noniterator  is 
type  Set  is  limited  private; 

procedure  Copy  {Froin^The_Set  :  in  Set; 

To_The_Set  :  in  out  Set) ; 

procedure  Clear  {The_Set  :  in  out  Set) ; 

procedure  Add  (The^Item  :  in  Item; 

To_The_Set  :  in  out  Set); 

procedure  Remove  (The_Item  :  in  Item; 

From_The_Set  ;  in  out  Set) ; 

procedure  Union  (Of_The_Set  :  in  Set; 

And_The_Set  :  in  Set; 

To_The_Set  :  in  out  Set) ; 

procedure  Intersection  (Of_The_Set  :  in  Set; 

An<3LThe_Set  :  in  Set; 

To_The_Set  :  in  out  Set) ; 

procedure  Difference  (Of_The_Set  :  in  Set; 

AncLThe^Set  :  in  Set; 

To_The_Set  :  in  out  Set); 

—  modified  by  Tuan  Nguyen 

—  20  Aug  95 

—  replacing  fianctions  with  procedures 


procedure  Is_E<3ual  {Left  :  rn  Set; 

Right  :  in  Set; 

Result  :  out  Boolean) ; 

procedure  Extent_Of  {The^Set  :  in  Set; 

Result  :  out  Natural) ; 


procedure  Is_Enpty  (The_Set  :  in  Set; 

Result  :  out  Boolean) ; 

procedure  Is_A_Jleniber  (The__Item  ;  in  Item; 

Of_The_Set  :  in  Set; 

Result  :  out  Boolean) ; 

procedure  Is^Subset  {Left  :  in  Set; 

Right  :  in  Set; 

Result  :  out  Boolean) ; 

procedure  Is_J\^Proper_Subset  (Left  :  in  Set; 

Right  ;  in  Set; 

Result  :  out  Boolean) ; 

—  end  of  modification 

function  Is_Egual  {Left  :  in  Set; 

Right  :  in  Set)  return  Boolean; 

function  Extent_Of  (The_Set  :  in  Set)  return  Natural; 

function  Is_Ertpty  (The^Set  ;  in  Set)  return  Boolean; 

function  Is_A^ember  (The_Item  :  in  Item; 

Of_The_Set  :  in  Set)  return  Boolean; 

function  Is_A_Subset  (Left  ;  in  Set; 

Right  :  in  Set)  return  Boolean; 

function  Is_A_Froper_Subset  {Left  :  in  Set; 

Right  :  in  Set)  return  Boolean; 

Overflow  :  exception; 

ItenuIs_In_Set  :  exception; 

Item_Is_Not_In_Set  :  exception; 

private 

type  Node; 

type  Set  is  access  Node; 

end  Se t_Siii?)le_Seguent ial_Unbounded_ManagedJIoni terator ; 
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SET  SIMPLE  SEQUENTIAL  UNBOUNDED  MANAGED  NONITERATOR 

ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

—  "Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Computer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 


with  Storage_Jlanager_Sequential; 

package  body  Set_Simple_Seguential_Unbo\indedJlanagedJWoniterator  is 

type  Node  is 
record 

The_Item  :  Item; 

Next  :  Set; 

end  record; 


procedure  Free  {The_Node  :  in  out  Node)  is 
begin 

null; 
end  Free; 

procedure  Set^ext  (The_Node  :  in  out  Node; 

To_Next  :  in  Set)  is 

begin 

The_^ode . Next  ; =  To_Next ; 
end  SetJMext; 

function  Next.Of  (TheJSTode  :  in  Node)  return  Set  is 
begin 

return  The_Node.Next; 
end  Next_0f; 


package  Node_Manager  is  new  Storage_Nanager_Sequential 

(Item  =>  Node, 

Pointer  =>  Set, 

Free  =>  Free, 

Set_Pointer  =>  Set_Next, 
Pointer_0f  =>Next_Of); 

procedure  Copy  ( FrorcL.The_Set  :  in  Set; 

To_The_Set  :  in  out  Set)  is 
Fronuindex  :  Set  :=  From_The_Set ; 

To^lndex  :  Set ; 
begin 

Node_Jlanager .  Free  (To_The_Set )  ; 
if  From_The_Set  /=  null  then 

To_The_Set  :=  NodeJlanager.New_Item; 

To_The_Set .The_Item  ;=  From_Index.The_Item; 
To_Index  :=  To_The_Set; 

From^Index  ;=  From_Index.Next; 
while  From_Index  /=  null  loop 

To_Index .  Next  :  =  Node_llanager .  New_I tern  ; 
To_Index  :=  To_Index.Next; 

To_Index.The_Item  :=  From_Index.The_Item; 
Fronuindex  :=  From_Index.Next; 
end  loop; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Copy; 


procedure  Clear  (The_Set  :  in  out  Set)  is 
begin 

Node_Manager , Free ( The_Se t ) ; 
end  Clear; 

procedure  Add  (The_Item  :  in  Item; 

To_The_Set  :  in  out  Set)  is 
TenporaryJNode  :  Set ; 

Index  :  Set  ;=  To_The_Set; 

begin 

while  Index  /=  null  loop 

if  Index . The_Item  =  The^Item  then 
raise  Item_Is_In_Set; 

else 

Index  Index. Next; 

end  if; 
end  loop; 

Temporary_Node  :=  Node_Nanager.New_Item; 
Temporary_Node  .The_Item  :=  The_Item; 
Tempor ary  JNode. Next  To_The_Set; 

To_The_Set  ;=  TenporaryJNode; 
exception 

when  StoragejError  => 
raise  Overflow; 

end  Add; 


procediire  Remove  (The_Item 

FrortL.The_Set 
Previous  :  Set ; 


in  I  tern; 

in  out  Set)  is 


Index  :  Set  ;=  From_'IhejSet; 
begin 

while  Index  /=  null  loop 

if  Index. The_Item  =  The_Item  then 
if  Previous  =  null  then 

From_ThejSet  :=  From_The_Set,Next; 

else 

Pr evi ous . Next  ; =  Index . Next ; 
end  if; 

Index . Next  : =  null ; 

Node^Manager . Free ( Index } ; 
return; 

else 

Previous  :=  Index; 

Index  :=  Index. Next; 
end  if; 
end  loop; 

raise  ItenL.ISjNot„InjSet; 
end  Remove; 


procedure  Union  (OfjThejSet  ;  in  Set; 

And_The_Set :  in  Set ; 

TOjThOjSet  :  in  out  Set)  is 


Set  OfjThCjSet; 
Set; 

Set; 

Set; 


Fronulndex 
TOjIndex 

TOjTop 

Temporary_Node 
begin 

Node_Manager , Free ( To_ThejSet ) ; 
while  From_Index  /=  null  loop 

Temporary jNode  :=  Node_Manager  .New_Item; 

Temporary JTode .  The ^1  tern  ;  =  Fr om_Index .  The^I  tern ; 
TenporaryJNode .Next  ;=  TOjThe_Set; 

To_The_Set  :=  TenporaryJNode; 

Fronjlndex  Froitjlndex.Next ; 
end  loop; 

From_Index  :=  AncLThe^Set; 

To_Top  :=  TOjThOjSet; 
while  Fronulndex  /=  null  loop 
TOjIndex  :=  ToJTop; 
while  TOjIndex  /=  null  loop 

if  Fronulndex. The_Item  =  TOjIndex,The_Item  then 
exit ; 

else 

TOjIndex  ;=  To_Index , Next ; 
end  if; 
end  loop; 

if  TOjIndex  =  null  then 

Tenporciry JNode  :  =  Node_.Manager .  New_,I tern; 
TenporaryjNode .The_Item  ;=  Fronulndex. The jl tern; 
TenporaryjNode . Next  ; =  To^The^Set ; 

To_The_Set  ;=  Tenporary^ode ; 
end  if; 

Fronulndex  :=  Fronulndex. Next; 
end  loop; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Union; 


procedure  Intersection  {Of_The_Set  ;  in  Set; 

AndjThCjSet  :  in  Set; 

TOjThejSet  ;  in  out  Set)  is 

Ofjindex  :  Set  :=  OfjThe_Set; 

AncLIndex  ;  Set; 

TenporaryJNode  :  Set ; 
begin 

Node_Manager .  Free  ( To_ThejSe  t ) ; 
while  Ofjindex  /=  null  loop 
Andjindex  :=  AndjThe_Set; 
while  Andjindex  /=  null  loop 

if  Of_Index.The_Item  =  And_Index.The_Item  then 
Tenporary_Node  :  =  Node_Manager  .New_Item; 
TenporaryJNode .  ThCjItem  ;  =  Of_lndex .  ThejItem; 
TenporaryJNode, Next  :=  TOj,The_Set; 

TOjThe_Set  TenporaryJNode; 
exit  ; 

else 

Andjindex  :=  And_Index.Next ; 
end  if; 
end  loop; 

Ofjindex  :=  Of_Index.Next; 
end  loop; 
exception 

when  StoragCjError  => 
raise  Overflow; 
end  Intersection; 

procedure  Difference  {Ofj,The_Set  :  in  Set; 

AndjThejSet  :  in  Set; 

TOjThe_Set  :  in  out  Set)  is 

Ofjindex  ;  Set  :=  Of_ThejSet; 

AndLIndex  :  Set ; 

TenporaryJNode  :  Set; 

begin 

Nodejtonager .  Free  ( To_Thej,Se  t ) ; 
while  Ofjindex  /=  null  loop 
Andjindex  :=  And^The^Set; 


221 


while  An^i^Index  /=  null  loop 

if  Of_Index.The_Item  =  And_Index.The_Item  then 
exit; 

else 

And_Index  :=  AncSLIndex.Next; 
end  if; 
end  loop; 

if  And_Index  =  null  then 

Teit^Jorary^Node  :=  Node Jlanager.New_I tern; 
Teir5)orary_Node.The_Iteni  :=  Of_Index.The_Item; 
Tenporary^Node . Next  ; =  To_The_Se t ; 

To_The_Set  :=  TemporaryJJode; 
end  if; 

Of_Index  :=  Of_Index.Next; 
end  loop; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Difference; 

modified  by  Tuan  Nguyen 
20  Aug  95 

replacing  functions  with  procedures 


procedure  Is_Equal  {Left 

Right 
Result 

begin 

Result  : “  Is^Equal (Lef t , Right ) ; 
end  Is_Equal; 

procedure  Extent_Of  (The_Set 

Result 

begin 

Result  :=  Extent_Of (The^Set) ; 
end  Extent_Of; 


in  Set; 
in  Set; 

out  Boolean)  is 


in  Set-¬ 
out  Natural)  is 


procedure  Is_En?>ty  (The_Set  :  in  Set; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is^Empty (The_Set) ; 
end  Is_Enpty; 


procedure  Is^AJIember 


{The_Item  :  in  I  tern; 
Of_The_Set  :  in  Set; 
Result  :  out  Boolean) 


begin 

Result  :=  Is_AJlember(The_Item,Of_The_Set)  ; 
end  Is_AJ5ember; 


is 


procedure  Is^A^-Subset  {Left 

Right 
Result 

begin 

Result  :=  Is^A^Subset{Left,Right) ; 
end  Is_A_Subset; 


in  Set; 
in  Set; 

out  Boolean)  is 


procedure  Is^A^Proper_Subset 


(Left 

Right 

Result 


in  Set; 
in  Set-¬ 
out  Boolean) 


begin 

Resul t  : =  Is_A_Proper_Subset ( Lef t , Right ) ; 
end  Is_A_Proper_Svibset; 


is 


end  of  modification 


function  Is_Egual  {Left  :  in  Set; 

Right  :  in  Set)  return  Boolean  is 
Left_Co\jnt  :  Natural  :=  0; 

Right_Coxint  ;  Natural  :=  0; 

Left_Index  ;  Set  :=  Left; 

Right_Index  :  Set; 

begin 

while  Left_Index  /-  null  loop 
Right_Index  ;=  Right; 
while  Right_Index  /=  null  loop 

if  Left_Index.The_Itein  =  Right_Index.The_Item  then 
exit  ; 

else 

Right^Index  :=  Right^Index . Next ; 
end  if; 
end  loop; 

if  Right_Index  =  null  then 
return  False; 

else 

Left_Count  ;=  Left_Count  +  1; 

Left_Index  :=  Left_Index.Next; 
end  if; 
end  loop; 

Right_Index  :=  Right; 


while  Right^Index  /*  null  loop 

Right_Co\jnt  :=  Right_Count  +  1; 

Right_Index  Right_Index.Next ; 

end  loop; 

return  (Left_Count  =  Right_Count) ; 
end  Is_Equal; 

fimction  Extent_0f  {The_Set  :  in  Set)  return  Natural  is 
Coiant  :  Natural  :=  0; 

Index  :  Set  :=  The„Set; 

begin 

while  Index  /=  null  loop 
Count  :=  Count  +  1; 

Index  :=  Index. Next; 
end  loop; 
retum  Count; 
end  Extent_Of; 

function  Is^Empty  (The_Set  :  in  Set)  return  Boolean  is 
begin 

return  (The_Set  =  null) ; 
end  ls_En5)ty; 

function  Is_A«Kember  (The_Iteiti  :  in  Item; 

Of_The_Set  :  in  Set)  return  Boolean  is 
Index  :  Set  :=  Of_The_Set; 
begin 

while  Index  /-  null  loop 

if  The_Item  =  Index. The_I tern  then 
return  True; 
end  if; 

Index  :=  Index. Next; 
end  loop; 
return  False; 
end  Is_A-Meinber; 

fxuiction  Is_A_Subset  (Left  :  in  Set; 

Right  :  in  Set)  return  Boolean  is 
Left_Index  ;  Set  Left; 

Right_Index  :  Set; 
begin 

while  Left_Index  /=  null  loop 
Right_Index  :=  Right; 
while  Right^Index  /=  null  loop 

if  Left_Index.The_Item  *=  Right_Index.The_Item  then 
exit; 

else 

Right_Index  Right_lndex.Next ; 
end  if; 
end  loop; 

if  Right_Index  =  null  then 
return  False; 

else 

Left_lndex  :=  Lef t_Index. Next ; 
end  if; 
end  loop; 
return  True; 
end  Is^A^Subset; 

fianction  Is_^_Proper_Subset  (Left  :  in  Set; 

Right  :  in  Set)  return  Boolean  is 
Left_Co\mt  :  Natural  :=  0; 

Right_Count  :  Natural  :=  0; 

Left_Index  :  Set  :=  Left; 

Right_Index  :  Set; 

lOegin 

while  Left_Index  /=  null  loop 
Right_Index  :=  Right; 
while  Right_Index  /=  null  loop 

if  Left_Index.The_Item  =  Right_Index.The_Item  then 
exit; 

else 

Right_Index  Right_Index . Next ; 

end  if; 
end  loop; 

if  Right_Index  «  null  then 
return  False; 

else 

Left_Count  :=  Left^Count  +  1; 

Left_Index  ;=  Left_Index.Next; 
end  if; 
end  loop; 

Right_Index  :=  Right; 

while  Right_Index  /=  null  loop 

Right^Count  ;=  Right_Co\int  +  1; 

Right_Index  Right_Index.Next ; 
end  loop; 

return  (Left_Count  <  Right_Count) ; 
end  ls^A_Proper_Subset; 

end  Set_Sinple_Sequential_UnboundedJManaged_Non  iterator ; 
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SET  SIMPLE  SEQUENTIAL  UNBOUNDED  MANAGED  NONITERATOR 

PSDL 


TYPE  Set_Siir?>le_Seqaential_UnboundedJManagec3jNoniterator 
SPECIFICATION 
GENERIC 

Item  ;  PRIVATE_TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

Front-The^Set  :  Set, 

To_The_Set  :  Set 
OUTPUT 

To_The_Set  :  Set 
EXCEPTIONS 

Overflow,  IterruIs^In^Set,  It  excels  JNot_In_Set 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Set  :  Set 
OUTPUT 

The_Set  :  Set 
EXCEPTIONS 

Overflow,  Item_Is_In_Set,  Iten\_Is_Not_In_Set 

END 

OPERATOR  Add 
SPECIFICATION 
INPUT 

The_Item  ;  Item, 

To_The_Set  :  Set 
OUTPUT 

To_The_Set  ;  Set 
EXCEPTIONS 

Overflow,  Item_IS— In_Set,  Item_Is_Not_In_Set 

END 

OPERATOR  Remove 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

Fron\jrhe_Set  :  Set 
OUTPUT 

From_The_Set  :  Set 
EXCEPTIONS 

Overflow,  Iteitt.Is_In_Set,  ItexcuIs_Not_In_Set 

END 

OPERATOR  Union 
SPECIFICATION 
INPUT 

Of_The_Set  :  Set, 

And_The_Set  :  Set, 

To_The_Set  :  Set 
OUTPUT 

To_The_Set  ;  Set 
EXCEPTIONS 

Overflow,  Item_Is_In_Set,  Item_Is_Not_In_Set 

END 

OPERATOR  Intersection 
SPECIFICATION 
INPUT 

Of_The_Set  ;  Set, 

And_The_Set  :  Set, 

To_The_Set  :  Set 
OUTPUT 

To_The_Set  :  Set 
EXCEPTIONS 

Overflow,  Item_Is_In_Set ,  IteitL.Is_Not_In_Set 

END 

OPERATOR  Difference 
SPECIFICATION 
INPUT 

Of_The_Set  :  Set, 


And^The^Set  :  Set, 

To_The_Set  :  Set 
OUTPUT 

To_The_Set  :  Set 
EXCEPTIONS 

Overflow,  ItenL.Is_In_Set,  Item_Is_Not_In_Set 

END 

OPERATOR  Is^Equal 

SPECIFICATION 

INPUT 

Left  :  Set, 

Right  :  Set 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  ItenL.Is_InL.Set,  ItertL.Is_Not_In_Set 

END 

OPERATOR  Extent_Of 

SPECIFICATION 

INPUT 

The_Set  ;  Set 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Item_Is_In_Set ,  Item_Is_Not_In_Set 

END 

OPERATOR  Is_Empty 

SPECIFICATION 

INPUT 

The_Set  :  Set 
OUTPUT 

Result  ;  Boolean 
EXCEPTIONS 

Overflow,  Item_ls_ln_Set ,  Item_Is_Not_In_Set 

END 

OPERATOR  Is_A^ember 

SPECIFICATION 

INPUT 

The_Item  :  Item, 

Of_The_Set  :  Set 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Item_ls_InL.Set ,  Item_Is_Not_ln_Set 

END 

OPERATOR  Is_A_Subset 

SPECIFICATION 

INPUT 

Left  :  Set, 

Right  ;  Set 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Item_Is_In_Set,  Item_Is_Not_In_Set 

END 

OPERATOR  Is^R^Proper_Subset 

SPECIFICATION 

INPUT 

Left  :  Set, 

Right  :  Set 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  ltem_Is_In_Set,  ItenuIs_Not_In_Set 

END 

END 

IMPLEMENTATION  ADA  Set_Siirple_Sequential_Unbounded_Managed_Noniterator 
END 
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SET  SIMPLE  SEQUENTIAL  UNBOUNDED  UNMANAGED  ITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

package  Set_Siir5>le_Sequential_Uiibotinded^Uninanaged_Iterator  is 


type  Set  is  limited  private; 

procedure 

Copy 

( FrorruThe_Set 

in 

Set; 

To„The_Set 

in 

out 

Set)  ; 

procedure 

Clear 

(The_Set 

in 

out 

Set)  ; 

procedure 

Add 

(The_Item 

in 

Item; 

To_The_Set 

in 

out 

Set)  ; 

procedure 

Remove 

(The_Item 

in 

I  tern; 

From_The_Set 

in 

out 

Set) ; 

procedure 

Union 

(Of_The_Set 

in 

Set; 

AndLThe^Set 

in 

Set; 

To_The_Set 

in 

out 

Set)  ; 

procedure 

Intersection 

(Of_The_Set 

in 

Set; 

And_The_Set 

in 

Set; 

To_The_Set 

in 

out 

Set)  ; 

procedure 

Difference 

(Of_The_Set 

in 

Set; 

And^The„Set 

in 

Set; 

To_The_Set 

in 

out 

Set)  ; 

modified  by  Tuan  Nguyen 

20  Aug  95 

replacing 

functions  with  procedures 

procedure 

Is_Equal 

(Left 

;  in 

Set; 

Right 

:  in 

Set; 

Result 

out  Boolean) 

procedure 

Extent_Of 

(The^Set 

in 

Set; 

Result 

out  Natural) 

procedure 

Is_Enpty 

(The„Set 

in 

Set; 

Result 

out  Boolean) 

procedure 

Is^AJMember 

(The^Item 

in 

Item; 

Of_The_Set 

;  in  Set; 

Result 

:  out  Boolean) ; 

procedure  Is^A^Subset 

(Left 

:  in  Set; 

Right 

:  in  Set; 

Result 

:  out  Boolean) ; 

procedure  Is^A_Proper_Subset 

(Left 

:  in  Set; 

Right 

:  in  Set ; 

Result 

;  out  Boolean) ; 

end  of  modification 

function  Is_Equal 

(Left  : 

in  Set; 

Right  : 

in  Set)  return 

Boolean; 

fimction  Extent_Of 

(The_Set  : 

in  Set)  return 

Natural ; 

function  Is_Empty 

(The_Set  : 

in  Set)  return 

Boolean; 

function  Is_A-lIember 

(The_Item  : 

in  Item; 

Boolean; 

Of_The_Set  : 

in  Set )  return 

function  Is^_Subset 

(Left 

in  Set; 

Boolean; 

Right  : 

in  Set)  return 

f\inction  Is_A>Proper_Subset 

(Left  : 

in  Set; 

Boolean; 

Right  : 

in  Set)  return 

generic 

with  procedure  Process  (The_Item  :  in  Item; 

Continue  :  out  Boolean) ; 
procedure  Iterate  { Over_The_Set  :  in  Set) ; 

Overflow  :  exception; 

Item_Is_In_Set  :  exception; 

Item_IsJNot_In_Set  :  exception; 

private 

type  Node; 

type  Set  is  access  Node; 

end  Set_Sin^le_Sequential_Unbounded_Unmanaged^I terator ; 
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SET  SIMPLE  SEQUENTIAL  UNBOUNDED  UNMANAGED  ITERATOR 

ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

--  Serial  Nviinber  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  {b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Coirputer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S,  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body  Set_Sinple_Sequential_UnboundedLUnmanaged_Iterator  is 

type  Node  is 
record 

The_Item  :  I tern; 

Next  :  Set; 
end  record; 


procedure  Copy  (FronL.The_Set  :  in  Set; 

To„The_Set  :  in  out  Set)  is 
Froin_Index  :  Set  :=  Froitt,The_Set  ; 

To^Index  :  Set ; 
begin 

if  Fronu.'Kae_Set  =  null  then 
To_The_Set  : =  null ; 

else 

To_The_Set  :=  new  Node' (The_Item  =>  FrortuIndex.The_Item, 
”  Next  =>  null) ; 


To_Index  :=  To_The_Set; 

Fron^Index  :  =  Froin_Index ,  Next  ; 
while  Fron\_Index  /»  null  loop 

To_Index.Next  :=  new  Node'  (The_Item  => 
Fronulndex .  The_Itein, 

Next  =>  null) ; 


To_Index  To_Index.Next ; 
Froitulndex  Froirt.Index.Next; 
end  loop; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 


end  Copy; 


procedure  Clear  (The_Set  ;  in  out  Set)  is 
begin 

The_Set  :  null ; 
end  Clear; 


procedure  Add  (The^Item  :  in  Item; 

To_The_Set  :  in  out  Set)  is 
Index  ;  Set  ;=  To_The_Set; 
begin 

while  Index  null  loop 

if  Index. The_I tern  =  The^Item  then 
raise  Itent_Is_In_Set  ; 

else 

Index  :=  Index. Next ; 
end  if; 
end  loop; 

To_The_Set  :=  new  Node  ‘  (The_I tern  =>  The_Item, 

Next  =>  To_The_Set ) ; 

exception 

when  Storage_Error  => 
raise  Overflow; 

end  Add; 

procedure  Remove  (The_Item  :  in  Item; 

From_The_Set  :  in  out  Set)  is 
Previous  :  Set; 

Index  :  Set  :=  From_The_Set ; 
begin 

while  Index  /=  null  loop 

if  Index. The_I tern  =  The_Item  then 
if  Previous  =  null  then 

Froitt.The_Set  :=  From_The_Set  .Next; 

else 

Previous . Next  : =  Index . Next ; 
end  if; 
return; 

else 

Previous  Index; 

Index  ;=  Index. Next; 
end  if; 
end  loop; 

raise  Itent.Is_Not_In_Set; 
end  Remove; 

procedure  Union  (Of_The_Set  :  in  Set; 

Andjrhe_Set:  in  Set; 

To_The_Set  :  in  out  Set)  is 

From^Index  :  Set  :=  Of_The..Set; 

To_Index  :  Set; 

To_Top  :  Set; 

begin 


To_The_Set  : =  null ; 

while  FroirL,Index  null  loop 

To_The_Set  new  Node’ (The_I tern  =>  FroB:uIndex.The_Item, 

Next  =>  To_The_Set)  ; 

Frortuindex  FronuIndex.Next; 

end  loop; 

Frorrulndex  :=  And^The_Set; 

To_Top  : =  To_The_Set ; 
while  Fronuindex  /=  null  loop 
To_Index  :=  To_Top; 
while  To_Index  /=  null  loop 

if  FroituIndex.The_Item  *=  To_Index . The_Item  then 
exit; 


else 

To_Index  :=  To_Index.Next; 
end  if ; 
end  loop; 

if  To_Index  =  null  then 

To_The_Set  :=  new  Node’  (The^Item  =;> 

Fronulndex .  The_I  tern. 

Next  =>  To_The_Set) ; 


end  if; 

Froirt.Index  :=  Fronulndex .  Next  ; 
end  loop; 
exception 

when  Storage_Error  ss> 
raise  Overflow; 
end  Union; 


procedure  Intersection  (Of_The_Set  :  in  Set; 

And-.The_Set  ;  in  Set; 

To_The_Set  :  in  out  Set)  is 

Of_Index  ;  Set  ;=  Of_The_Set; 

AndLIndex  :  Set; 
begin 

To_The_Set  :=  null; 
while  Of_Index  /=  null  loop 
AndLIndex  : =  And_The_Set ; 
while  AndLIndex  /=  null  loop 

if  Of_Index.The_Item  =  And_Index.The_Item  then 
To_The_Set  new  Node'  (The„Item  => 


Of^Index .  The^Item, 


Next  =>  To„The_Set) ; 


exit; 

else 

AncLIndex  :=  And_Index,Next; 
end  if; 
end  loop; 

Of_Index  Of^Index.Next ; 
end  loop; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Intersection; 


procedure  Difference  (Of_The_Set  :  in  Set; 

And_The_Set  ;  in  Set; 

To_The_Set  :  in  out  Set)  is 

Of_Index  :  Set  :=  Of_The_Set; 

AncLIndex  :  Set; 
begin 

To_The_Set:=  null; 
while  Of_Index  /=  null  loop 
AncLIndex  :=  AncLThe_Set; 
while  AndLIndex  /=  null  loop 

if  Of_Index.The_Item  ®  AndLIndex. The_I tern  then 
exit; 

else 

AndLIndex  ;=  AndLIndex .  Next  ; 
end  if ; 
end  loop; 

if  And_Index  =  null  then 

To_The„Set  :=  new  Node '  {The_I tern  =>  Of_Index.The_Item, 
Next  =>  To_The_Set) ; 

end  if; 

Of_Index  ; =  Of_Index . Next ; 
end  loop; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Difference; 

—  modified  by  Tuan  Nguyen 
20  Aug  95 

—  replacing  fxmctions  with  procedures 


procedure  Is_Equal  (Left 

Right 
Result 

begin 

Result  : =  Is_Equal (Left, Right } ; 
end  ls_E<3ual; 

procedure  Extent_Of  (The_Set 

Result 

begin 

Result  :=  Extent_Of (The_Set) ; 


:  in  Set; 

:  in  Set; 

;  out  Boolean)  is 


:  in  Set; 

:  out  Natural)  is 
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end  Extent_Of; 
procedure  Is_Eitpty 


(The_Set  :  in  Set; 

Result  :  out  Boolean)  is 

begin 

Result  : =  I s_Enpty ( The_Se t ) ; 
end  Is_Einpty; 


procedure  Is_A_JWeinber 


(The_Item  :  in  Item; 
Of_The_Set  :  in  Set; 
Result  :  out  Boolean) 

begin 

Result  :  =  Is_AJ!eiriber  ( The_I tem ,  Of_The_Set )  ; 
end  Is_JVu_Meiiiber  ; 


procedure  Is^A^SiJbset  (Left 

Right 
Result 

begin 

Result  :=  Is.JV_S\ibset  (Left, Right)  ; 
end  Is_A^Subset; 


in  Set; 
in  Set; 

out  Boolean)  is 


procedure  Is_A_Proper_Subset 


(Left 

Right 

Result 


in  Set; 
in  Set; 
out  Boolean) 


begin 

Result  :=  Is_A_Proper_Subset (Left, Right) ; 
end  Is_A_Proper_Subset; 


is 


end  of  modification 

fxmction  Is_Equal  (Left  :  in  Set; 

Right  :  in  Set)  return  Boolean  is 
Left_Count  :  Natural  :=  0; 

Right_Count  :  Natural  :=  0; 

Left_Index  ;  Set  :=  Left; 

Right_Index  :  Set; 

begin 

while  Left_Index  /=  null  loop 
Right_Index  Right; 
while  Right_Index  /=  null  loop 

if  Left_Index.The_Item  =  Right_Index.The_Item  then 
exit; 

else 

Right_Index  ;=  Right_Index.Next ; 
end  if; 
end  loop; 

if  Right_Index  =  null  then 
return  False; 

else 

Left^Count  :=  Left_Count  +  1; 

Left_lndex  :=  Lef t_Index.Next ; 
end  if; 
end  loop; 

Right_Index  :=  Right; 

while  Right_Index  /=  null  loop 

Right_Count  :=  Right_Count  +  1; 

Right_Index  :=  Right_Index .  Next  ; 
end  loop; 

return  (Left_Count  =  Right_Count) ; 
end  Is_Equal; 

function  Extent_Of  (The_Set  ;  in  Set)  return  Natural  is 
Count  :  Natural  :=  0; 

Index  ;  Set  :=  The_Set; 

begin 

while  Index  /=  null  loop 
Count  :=  Coxmt  +  1; 

Index  ;=  Index. Next; 
end  loop; 
return  Count; 
end  Extent_Of; 

function  Is_Etr?3ty  {The_Set  :  in  Set)  return  Boolean  is 
begin 

return  (The^Set  =  null) ; 
end  Is_Eit?>ty; 

function  Is_A_Meiriber  (The_Item  :  in  Item; 


Of_The_Set  :  in  Set)  return  Boolean  is 
Index  :  Set  :=  Of_The_Set; 
begin 

while  Index  /=  null  loop 

if  The_Item  =  Index. The_I tem  then 
return  True; 
end  if; 

Index  :=  Index. Next; 
end  loop; 
return  False; 
end  Is_AJMeinber; 

function  Is^^Subset  (Left  :  in  Set; 

Right  :  in  Set)  return  Boolean  is 
Left_Index  :  Set  :=  Left; 

Right_Index  :  Set; 
begin 

while  Left_Index  /=  null  loop 
Right_Index  :=  Right; 
while  Right_Index  /=  null  loop 

if  L€ft_Index.The_Item  =  Right_Index.The_Item  then 
exit; 

else 

Right_Index  :=  Right_Index . Next ; 
end  if; 
end  loop; 

if  Right_Index  =.  null  then 
return  False; 

else 

Left_Index  :=  Lef t_Index. Next; 
end  if; 
end  loop; 
return  True; 
end  Is_A^Subset; 

function  Is,^Proper_Subset  (Left  ;  in  Set; 

Right  :  in  Set)  return  Booleeui  is 
Left_Count  :  Natural  ;=  0; 

Right_Count  :  Natural  : =  0 ; 

Left_Index  :  Set  :=  Left; 

Right_lndex  :  Set; 
begin 

while  Left__Index  /=  null  loop 
Right_Index  Right; 
while  Right_Index  /=  null  loop 

if  Left_Index.The_Item  =  Right_Index.The_Item  then 
exit  ; 

else 

Right_Index  :=  Right_Index.Next; 
end  if; 
end  loop; 

if  Right_Index  =  null  then 
return  False; 

else 

Left_Count  :=  Left_Count  +  1; 

Le f t^Index  t-  Lef t_Index . Next ; 
end  if; 
end  loop; 

Right_Index  z~  Right; 

while  Right_lndex  /=  null  loop 

Right_Count  :=  Right_Count  +  1; 

Right_Index  :=  Right_Index.Next ; 
end  loop; 

return  (Left_Coxmt  <  Right_Count)  ; 
end  Is_JUProper_Subset; 

procedure  Iterate  (Over_The_Set  :  in  Set)  is 
The_Iterator  :  Set  :=  Over_The_Set ; 

Continue  :  Boolean ; 

begin 

while  The_Iterator  /=  null  loop 

Process (The_Iterator.The_Item,  Continue) ; 
exit  when  not  Continue; 

The_Iterator  :=  The_Iterator .Next; 
end  loop; 
end  Iterate; 

end  set_Siiiple_Sequential_Unbounded_Unmanaged_Iterator ; 
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SET  SIMPLE  SEQUENTIAL  UNBOUNDED  UNMANAGED  ITERATOR 

PSDL 

TXPE  Set  Sin5>le_Sequential_Unbounded_UnmanagecLIterator 

END 

SPECIFICATION 

GENERIC 

OPERATOR  Is_Equal 

Item  ;  PRIVATE  TYPE 

SPECIFICATION 

OPERATOR  Copy 

INPUT 

SPECIFICATION 

Left  :  Set, 

INPUT 

Right  :  Set 

From_The  Set  :  Set, 

OUTPUT 

To  The  Set  :  Set 

Result  :  Boolean 

OUTPUT 

EXCEPTIONS 

To  The  Set  :  Set 

Overflow,  Item_Is_IrL_Set,  Itein_IsJNot_In_Set 

EXCEPTIONS 

END 

Overflow,  Item_Is  In  Set,  Itern_Is_Not_In_Set 

OPERATOR  Extent^Of 

SPECIFICATION 

END 

OPERATOR  Clear 

INPUT 

SPECIFICATION 

The_Set  :  Set 

INPUT 

OUTPUT 

The  Set  :  Set 

Result  :  Natural 

OUTPUT 

EXCEPTIONS 

The  Set  :  Set 

Overflow,  IteitL.Is_In_Set ,  IteiTu.Is_Not_In_Set 

EXCEPTIONS 

END 

Overflow,  Item_Is  In_Set,  ItenuIs^ot_In_Set 

END 

OPERATOR  Is^Empty 

SPECIFICATION 

OPERATOR  Add 

INPUT 

SPECIFICATION 

The_Set  :  Set 

INPUT 

OUTPUT 

The_Item  ;  Item, 

Result  :  Boolean 

To  The  Set  :  Set 

EXCEPTIONS 

OUTPUT 

Overflow,  Iteitu,Is_In_Set,  IteiiL.Is_Not_In_Set 

To_The_Set  :  Set 

END 

EXCEPTIONS 

Overflow,  Itenuls  In  Set,  Item_IsJJot_In_Set 

OPERATOR  Is^ajlember 

END 

SPECIFICATION 

INPUT 

OPERATOR  Remove 

The_Item  :  Item, 

SPECIFICATION 

Of_The_Set  :  Set 

INPUT 

OUTPUT 

The  Item  :  Item, 

Result  :  Boolean 

From_The  Set  :  Set 

EXCEPTIONS 

OUTPUT 

Overflow,  IteitL.Is_In_Set,  Item_Is_Not_In_Set 

Fromjrhe_Set  :  Set 

END 

EXCEPTIONS 

Overflow,  IterrL.Is  In_Set,  Item_Is_Not_In_Set 

OPERATOR  IS_A^Subset 

END 

SPECIFICATION 

INPUT 

OPERATOR  Union 

Left  ;  Set, 

SPECIFICATION 

Right  ;  Set 

INPUT 

OUTPUT 

Of  The  Set  :  Set, 

Result  :  Boolean 

And_The  Set  ;  Set, 

EXCEPTIONS 

To  The  Set  :  Set 

Overflow,  Item_Is_In_Set,  It€m_Is_Not_In_Set 

OUTPUT 

END 

To  The  Set  ;  Set 

EXCEPTIONS 

OPERATOR  Is^A-.Proper_Subset 

Overflow,  ltem_Is  In  Set,  Item_ls_Not„In^Set 

SPECIFICATION 

END 

INPUT 

Left  :  Set, 

OPERATOR  Intersection 

Right  ;  Set 

SPECIFICATION 

OUTPUT 

INPUT 

Result  :  Boolean 

Of  The  Set  ;  Set, 

EXCEPTIONS 

And_The  Set  :  Set, 

Overflow,  Item_Is_In_Set,  ltem_Is_Not_In_Set 

To_The_Set  :  Set 

END 

OUTPUT 

To_The_Set  :  Set 

OPERATOR  Iterate 

EXCEPTIONS 

SPECIFICATION 

Overflow,  Iteituls_In_Set,  ItenuIs_Not_In_Set 

GENERIC 

END 

Process  :  PROCEDURE I The_I tern  :  in[t  :  Item],  Continue  :  out[t  : 

Boolean] ] 

OPERATOR  Difference 

INPUT 

SPECIFICATION 

Over_The_Set  :  Set 

INPUT 

EXCEPTIONS 

Of„The_Set  :  Set, 

Overflow,  Item_Is_In_Set,  ItenuIsJNot_In^Set 

And_The_Set  :  Set, 

END 

To_The_Set  :  Set 

OUTPUT 

END 

To_The_Set  :  Set 

IMPLEMENTATION  ADA  Set_SiKple_Seguential_Unbounded_Unmanaged_Iterator 

EXCEPTIONS 

END 

Overflow,  Iteii\_Is„In_Set,  Item_IsJNot_In_Set 
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SET  SIMPLE  SEQUENTIAL  UNBOUNDED  UNMANAGED  NONITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

package  Set  Simple  Sequential^Unbotznded^UnmanagedLNoniterator  is 


type  Set  is  limited  private; 

procedure 

Copy 

(From_The_Set 

in 

Set; 

To_The_Set 

in 

out 

Set)  ; 

procedure 

Clear 

(The^Set 

in 

out 

Set)  ; 

procedure 

Add 

(The^Item 

in 

Item; 

To_The_Set 

in 

out 

Set)  ; 

procedure 

Remove 

(The^Item 

in 

Item; 

Fromjrhe_„Set 

in 

out 

Set)  ; 

procedure 

Union 

(Of_The_Set 

in 

Set; 

And_The_Set 

in 

Set; 

To_The„Set 

in 

out 

Set)  ; 

procedure 

Intersection 

(Of_The_Set 

in 

Set; 

AncLThe_,Set 

in 

Set; 

To_The_Set 

in 

out 

Set) ; 

procedure 

Difference 

(Of_The_Set 

in 

Set; 

AncLThe_Set 

in 

Set; 

To_The_Set 

in 

out 

Set) ; 

modified  by  Tuan  Nguyen 

20  Aug  95 

replacing 

fiinctions  with  procedures 

procedure 

Is_Equal 

(Left 

i  in 

Set; 

Right 

;  in 

Set; 

Result 

out  Boolean) ; 

procedure 

Extent^Of 

(The^Set 

in 

Set; 

Result 

out  Natural) ; 

procedure 

Is_Enpty 

(The^Set 

in 

Set; 

Result 

out  Boolean) ; 

procedure  Is^A_Hember 

(The_Item 

in  Item; 

Of_The_Set 

in  Set; 

Result 

out  Boolean) ; 

procedure  Is_A_Subset 

(Left 

in  Set-¬ 

Right 

in  Set; 

Result 

out  Boolean) ; 

procedure  Is_A^Proper_Subset 

(Left 

in  Set; 

Right 

in  Set; 

Result 

out  Boolean) ; 

end  of  modification 

function  Is_Equal 

(Left  : 

in  Set; 

Right  : 

in  Set)  return  Boolean 

fimction  Extent_,Of 

(The_Set  : 

in  Set)  return  Natural 

function  Is_Eitpty 

(The^Set  ; 

in  Set)  return  Boolean 

function  Is_Au_Meinber 

(The_Item  : 

in  Item; 

Of  The^Set  : 

in  Set)  return  Boolean 

function  Is_A^Subset 

(Left  : 

in  Set; 

Right  : 

in  Set)  return  Boolean 

function  Is_A^Proper_Subset 

(Left  : 

in  Set; 

Right  : 

in  Set)  return  Boolean 

Overflow  :  exception; 

ItenuIs_ln_Set  :  exception; 

Iten\_Is_>Iot_In_Set  :  exception; 

private 

type  Node; 

type  Set  is  access  Node; 

end  Set_Simple_Se«3uential_Unbounded_UnmanagedJJoniterator ; 
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SET  SIMPLE  SEQUENTIAL  UNBOUNDED  UNMANAGED  NONITERATOR 

ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Con^uter 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body  Set_Siittple_Sequential_Unbounded^Unmanaged_Noniterator  is 

type  Node  is 
record 

The_Item  :  I  tern; 

Next  :  Set; 
end  record; 


procedure  Copy  (FroirL.The_Set  :  in  Set; 

To_The_Set  :  in  out  Set)  is 
Fronulndex  :  Set  :=  FroitL.The_Set ; 

To_Index  :  Set; 
begin 

if  FronL.The_Set  =  null  then 
To_The_Set  : =  null ; 

else 

To_The_Set  :=  new  Node '  (The_I tern  =>  Front-Index.The_Item, 
Next  =>  null) ; 


To_Index  :=  To_The_Set; 

Fronulndex  :=  Fronulndex . Next ; 
while  Fronulndex  /=  null  loop 

To_Index.Next  :=  new  Node  * (The_I tern  => 
Fron^_Index .  The^Item, 

Next  =5>  null); 


To_Index  To_Index.Next ; 

Fronuindex  :=  From^Index . Next ; 
end  loop; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Copy; 


procedure  Clear  {The_Set  ;  in  out  Set)  is 
begin 

The_Set  : =  null ; 
end  Clear; 


procedure  Add  {The_Item  :  in  I tern; 

To_The_Set  ;  in  out  Set)  is 
Index  :  Set  To_The_Set; 
begin 

while  Index  /=  null  loop 

if  Index. The_Item  =  The_Itein  then 
raise  Iten\_IS-.IrL_Set; 

else 

Index  :=  Index. Next; 
end  if; 
end  loop; 

To_The_Set  :=  new  Node ' (The_I tern  =>  The_Item, 

”  Next  =>  To_The_Set)  ; 

exception 

when  Storage_Error  => 
raise  Overflow; 

end  Add; 

procedure  Remove  (The_Item  :  in  I  tern; 

From_The_Set  :  in  out  Set)  is 
Previous  :  Set; 

Index  :  Set  :=  From_The_Set; 
begin 

while  Index  /=  null  loop 

if  Index. The_I tern  =  The_Item  then 
if  Previous  =  null  then 

From_The_Set  :=  FronuThe_Set  .Next  ,- 

else 

Previous .Next  Index -Next; 
end  if; 
return; 

else 

Previous  :=  Index; 

Index  Index. Next ,- 
end  if; 
end  loop; 

raise  Iteir^_IsJNot_In^Set; 
end  Remove; 

procedure  Union  (Of_The_Set  :  in  Set; 

AncLThe_Set :  in  Set ; 

To_The_Set  :  in  out  Set)  is 

Froxtt_Index  :  Set  :=  Of_The_Set; 

To_Index  :  Set; 

To_Top  :  Set; 

begin 


To_The_Set  :=  null; 

while  From_Index  /«  null  loop 

To_The_Set  :=  new  Node*  {The_I tern  =>  From_Index.The_Item, 
Next  =>  To_The_Set)  ; 
Froiruindex  :=  FronuIndex.Next ; 
end  loop; 

From^Index  And_The_Set; 

To_Top  :=  To_The_Set; 
while  Frooulndex  /==  null  loop 
To_Index  ;=  To_Top; 
while  To_Index  /=  null  loop 

if  FronuIndex-The_Item  =  To_Index.The_Item  then 
exit; 


else 


To_Index  :=  To_Index.Next; 
end  if; 
end  loop; 

if  To_Index  =  null  then 

To_The_Set  new  Node’  (The_Item 
Fr  onuindex .  The_I  tern , 


Next 


To_The_Set) ; 


end  if; 

Fronulndex  :=  FronL.Index.Next; 
end  loop; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Union; 


procedure  Intersection  (Of_The_Set  :  in  Set; 

AndUThe_Set  :  in  Set; 

Tojrhe^Set  :  in  out  Set)  is 

Of_Index  :  Set  :=  Of_The_Set; 

AncLIndex  :  Set; 
begin 

To„The_Set  :=  null; 
while  Of_Index  /=  null  loop 
AncLIndex  ;=  And_The_Set; 
while  And_Index  /=  null  loop 

if  Of_Index.The_Item  =*  And^Index . The^Item  then 
To_The_Set  :=  new  Node'  (The_Item  => 


Of_Index . The_I tern, 


Next  =>  To_The_Set); 


exit; 

else 

An<i_Index  :=  And^Index.Next; 
end  if; 
end  loop; 

Of_Index  :=  Of_Index.Next; 
end  loop; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Intersection; 


procedure  Difference  {Of_The_Set  :  in  Set; 

And_The_Set  :  in  Set; 

To_The_Set  ;  in  out  Set)  is 

Of_Index  :  Set  ;=  Of_The_Set; 

And_Index  :  Set; 
begin 

To_The_Set:=  null; 
while  Of_Index  /=  null  loop 
AncLIndex  ;=  And_The_Set; 
while  And_Index  /=  null  loop 

if  Of_Index.The_Item  =  AndLIndex . The_Item  then 
exit; 

else 

AncLIndex  i-  AncSLIndex.Next; 
end  if; 
end  loop; 

if  And_Index  -  null  then 

To_The_Set  :«  new  Node '  (The_I tern  =>  Of_Index.The_Item, 
Next  =>  To_The_Set) ; 

end  if; 

Of^Index  :=  Of_Index.Next ; 
end  loop; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Difference; 


—  modified  by  Tueui  Nguyen 

—  20  Aug  95 

—  replacing  functions  with  procedures 


procedure  Is_Equal  (Left 

Right 
Result 

begin 

Result  : =  Is_Equal (Left , Right) ; 
end  Is_Equal; 

procedure  Extent^Of  (The^Set 

Result 

begin 

Result  :=  Extent_0f (The_Set) ; 


in  Set; 
in  Set; 

out  Boolean)  is 


in  Set; 

out  Natural)  is 
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end  Extent_Of; 


procedure  Is_Empty  {The_Set  :  in  Set; 

Result  :  out  Boolean)  is 

begin 

Result  :=  Is__Errpty{The_Set)  ; 
end  Is_Enpty; 


procedure  IsJR^ember 


(The_Item  :  in  Item; 
Of_The_Set  :  in  Set; 
Result  :  out  Boolean) 

begin 

Result  :=  Is_A>.Member  (The_Item,Of_The_Set)  ; 
end  Is_AJMeiriber; 


procedure  Is^A^_Subset  (Left 

Right 
Result 

begin 

Result  :=  Is_A^Subset (Left, Right) ; 
end  Is_A-Subset; 


in  Set; 
in  Set; 

out  Boolean)  is 


procedure  IsJv_Proper_Subset 


(Left 

Right 

Result 


in  Set; 
in  Set; 
out  Boolean) 


begin 

Result  :=  Is_A_Proper_Subset (Left, Right) ; 
end  Is_A^Proper_Subset; 


is 


end  of  modification 


function  Is_Equal  (Left  :  in  Set; 

Right  :  in  Set)  return  Boolean  is 
Left_Co\int  :  Natural  :=  0; 

Right_Count  :  Natural  ;=  0; 

Left_Index  ;  Set  :=  Left; 

Right_Index  :  Set; 

begin 

while  Left^Index  /»  null  loop 
Right_Index  :=  Right; 
while  Right_Index  /=  null  loop 

if  Left_Index-The_Item  =  Right_Index.The_Item  then 
exit; 

else 

Right_Index  Right^Index.Next ; 
end  if; 
end  loop; 

if  Right_lndex  =  null  then 
return  False; 

else 

Left_Co\jnt  :=  Left_Count  +  1; 

Left_Index  ;=  Left_Index.Next ; 
end  if; 
end  loop; 

Right__Index  ;=  Right; 

while  Right^Index  /=  null  loop 

Right_Cotint  Right_Count  +  1; 

Right_Index  Right_Index*Next ; 
end  loop; 

return  (Left_Count  =  Right_Count) ; 
end  ls_Equal; 

function  Extent_Of  (The_Set  :  in  Set)  return  Natural  is 
Count  ;  Natural  :=  0; 

Index  :  Set  :=  The^Set; 

begin 

while  Index  /=  null  loop 
Co\mt  :=  Count  +  1; 

Index  :=  Index. Next; 
end  loop; 
return  Count; 
end  Extent_Of; 


function  Is_Ettipty  (The^Set  :  in  Set)  return  Boolean  is 
begin 

retxim  (The^Set  =  null)  ; 
end  Is^Enpty; 

function  Is_A_Nember  (The_Item  :  in  Item; 

Of_The_Set  :  in  Set)  return  Boolean  is 
Index  :  Set  ;=  Of_The_Set; 
begin 

while  Index  /=  null  loop 

if  The_Item  =  Index. The_I tern  then 
return  True; 
end  if; 

Index  :=  Index. Next; 
end  loop; 
return  False; 
end  Is^AJIember; 

function  Is^^Subset  (Left  :  in  Set; 

Right  ;  in  Set)  return  Boolean  is 
Left_Index  :  Set  ;=  Left; 

Right_Index  :  Set; 
begin 

while  Left_Index  /=  null  loop 
Right_Index  :=  Right; 
while  Right_Index  /=  null  loop 

if  Left_Index.The_Item  =  Right_Index.The_Item  then 
exit; 

else 

Right_Index  Right_Index.Next ; 
end  if; 
end  loop; 

if  Right_Index  -  null  then 
return  False; 

else 

Left_Index  :=  Left_Index.Next; 
end  if; 
end  loop; 
return  True; 
end  Is_A^Subset; 

function  Is_A  Proper_Subset  (Left  :  in  Set; 

Right  ;  in  Set)  return  Boolean  is 
Left_Count  :  Natural  :=  0; 

Right^Count  ;  Natural  :=  0; 

Left_Index  ;  Set  :=  Left; 

Right_Index  :  Set; 

begin 

while  Left_Index  null  loop 
Right_Index  :=  Right; 
while  Right_Index  /=  null  loop 

if  Left_Index.The_Item  =  Right_Index.The_Item  then 
exit; 

else 

Right_Index  :=  Right_Index.Next; 
end  if; 
end  loop; 

if  Right^Index  =  null  then 
return  False; 

else 

Left_Co\mt  ;=  Left_Count  +  1; 

Left_Index  :=  Left_Index.Next; 
end  if; 
end  loop; 

Right_Index  :=  Right; 

while  Right_Index  /=  null  loop 

Right_Count  ;=  Right_Coiant  +  1; 

Right_Index  :=  Right_Index.Next; 
end  loop; 

return  (Left_Count  <  Right_Coxmt) ; 
end  Is_J^Proper_Subset; 

end  Se  t__Sinple__Secpient i  a  l_UnboundecLUnmanagedJJoni  tera  tor ; 
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SET  SIMPLE  SEQUENTIAL  UNBOUNDED  UNMANAGED  NONITERATOR 

PSDL 


TYPE  Set_SiBnple_Sequential_UnboundedLUninanaged_Noniterator 
SPECIFICATION 
GENERIC 

Item  ;  PRIVATE_TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

Froirt_The_.Set  :  Set, 

To_The_Set  :  Set 
OUTPUT 

To_The_Set  :  Set 
EXCEPTIONS 

Overflow,  Iteii:uIs_In_Set,  IteiiuIs_Not_In_Set 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Set  :  Set 
OUTPUT 

The^Set  :  Set 
EXCEPTIONS 

Overflow,  ItenuIs_In_Set,  Iten\_Is_Not_In_Set 

END 

OPERATOR  Add 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

To_The_Set  :  Set 
OUTPUT 

To_The_Set  :  Set 
EXCEPTIONS 

Overflow,  Ite«uIs_In^Set,  ItertL,Is_Not_In_Set 

END 

OPERATOR  Remove 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

FrorrL_The„Set  :  Set 
OUTPUT 

Froirt,The_Set  :  Set 
EXCEPTIONS 

Overflow,  Iter^^_Is_In_Set,  Item_IsJMot_IrL.Set 

END 

OPERATOR  Union 
SPECIFICATION 
INPUT 

Of_The_Set  :  Set, 

And_The_Set  :  Set, 

To_The_Set  :  Set 
OOTPUT 

To_The_Set  ;  Set 
EXCEPTIONS 

Overflow,  Item_Is_In_Set,  Item^IsJ^ot_In_Set 

END 

OPERATOR  Intersection 
SPECIFICATION 
INPUT 

Of_The_Set  :  Set, 

And_The_Set  :  Set, 

To_The_Set  :  Set 
OUTPUT 

To_The_Set  :  Set 
EXCEPTIONS 

Overflow,  Item_Is_In_Set,  Item_Is_Not_In_Set 

END 

OPERATOR  Difference 
SPECIFICATION 
INPUT 

Of_The_Set  ;  Set, 

AncLThe^Set  :  Set, 


To_The_Set  :  Set 
OUTPUT 

To_The_Set  :  Set 
EXCEPTIONS 

Overflow,  Item_ls_ln_Set,  Itenv_Is_Not_In_Set 

END 

OPERATOR  IS^Equal 

SPECIFICATION 

INPUT 

Left  :  Set, 

Right  :  Set 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  ItenuIs_In_Set ,  Itein_Is_Not_In_Set 

END 

OPERATOR  Extent^Of 

SPECIFICATION 

INPUT 

The^Set  :  Set 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Ite]H_Is_In_Set,  IteiA..Is_JJot_ln_Set 

END 

OPERATOR  IS_Eir?)ty 

SPECIFICATION 

INPUT 

The_Set  :  Set 
OUTPUT 

Result  ;  Boolean 
EXCEPTIONS 

Overflow,  Iteit\_ls_In_Set ,  IteitulsJJot_In_Set 

END 

OPERATOR  Is_A_Member 

SPECIFICATION 

INPUT 

The_Item  :  Item, 

Of_The_Set  :  Set 
OUTPUT 

Result  ;  Boolean 
EXCEPTIONS 

Overflow,  Item_Is_In_Set,  Item_IsJNot_In_Set 

END 

OPERATOR  Is_A-Subset 

SPECIFICATION 

INPUT 

Left  ;  Set, 

Right  ;  Set 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Iten\_Is_In_Set,  Item_IsJNot_In_Set 

END 

OPERATOR  Is.A_Proper_Subs€t 

SPECIFICATION 

INPUT 

Left  :  Set, 

Right  :  Set 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Item_Is_In_Set,  ItertuIs_Not_In_Set 

END 

END 

IMPLEMENTATION  ADA 

Se  t_Sia?5le_Seguent  ial_Unbounded_Unmanaged_Noni  ter  a  tor 

END 
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BINARY  SEARCH 


ADA  SPECIFICATIONS 


generic 

type  Key  is  limited  private; 

type  Item  is  limited  private; 

type  Index  is  (<>) ; 

type  Items  is  array (Index  range  <>)  of  Item; 

with  function  Is_Equal  (Left  :  in  Key; 

Right  :  in  Item)  return 

Boolean; 

with  f\jnction  Is_Less_Than  (Left  :  in  Key; 

Right  :  in  Item)  return 

Boolean; 

package  Binary^Search  is 

—  modified  by  Tuan  Nguyen 

—  20  Jan  95 


—  adding  procedures  to  replace  fionctions 


procedure  Location_Of  (The_Key  :  in  Key; 

In_The_I terns  :  in  Items; 
Result  :  out  Index) ; 


—  end  of  modification 


fxinction  Location_Of 
return  Index; 


(The_Key  :  in  Key; 

In_The_I terns  ;  in  Items) 


IteiruNot_Found  ;  exception; 


end  Binary_Search ; 


BINARY  SEARCH 
ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady 
Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3) 

(ii) 

—  of  the  rights  in  Technical  Data  and  Cooaputer 

—  Software  Clause  of  FAR  52.227-7013,  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body  Binary_Search  is 

—  modified  by  Tuan  Nguyen 

—  20  Jan  95 

—  adding  procedures  to  replace  functions 

procedure  Location_Of  (The_Key  :  in  Key; 

In_The„I terns  :  in  Items; 

Result  :  out  Index)  is 

begin 

Result  :=  Location_Of  (The^Key,  In_The_Iteins)  ; 
end  Location^Of; 

—  end  of  modification 


f\mction  Location_Of  (The^Key  :  in  Key; 

In_The_I terns  :  in  Items) 

return  Index  is 

Lower_Index  :  Index  :=  In_The_Items ‘First ; 
IJpper^Index  :  Index  In_The_Iteins ‘Last; 
The_Index  :  Index ; 
begin 

while  Lower_Index  <=  upper_Index  loop 
The_Index 

Index '  Val  ( ( Index '  Pos  (Lower_Index)  + 
Index ‘ Pos (Upper_Index ) )  /  2 ) ; 

if  Is_Equal(The_Key, 
In_The_Items(The_Index) )  then 

return  The_Index; 
elsif  Is_Less_Than(The_Key, 

In_The_I  terns  ( The_Index ) )  then 

exit  when  (The_Index  - 
In_The_I terns ‘ First ) ; 

Upper_.Index  :  =  Index '  Pred  ( The_Index ) ; 

else 

exit  when  (The_Index  = 

In_The_Items ‘ Last ) ; 

Lower_Index  ; =  Index ' Succ ( The_Index ) ; 
end  if; 
end  loop; 

raise  IterO^ot^Found; 
end  Location_Of; 

end  Binary_Search; 


BINARY  SEARCH 
PSDL 


OPERATOR  Location_0f 
SPECIFICATION 
GENERIC 

Key  ;  PRIVATE^TYPE, 

Item  :  PRIVATE^TYPE, 

Index  :  DISCRETE_TyPE, 

Items  :  ARRAY  [ARRAY_ELEMENT  :  Item,  ARRAY_INDEX  : 
Index]  , 

IS^Equal  :  FUNCTION [Left  ;  Key,  Right  :  Item, 
RETURN  ;  Boolean] , 

Is_Less_Than  :  FUNCTION  [Left  :  Key,  Right  :  Item, 
RETURN  :  Boolean] 


INPUT 

The_Key  :  Key, 

In_The_l terns  :  Items 
OUTPUT 

Result  :  Index 
EXCEPTIONS 

1 1  enuNo  t_Found 

END 

IMPLEMENTATION  ADA  Location_0f 
END 
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BINARY  INSERTION  SORT 


ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 
type  Index  is  (<>) ; 

type  Items  is  array (Index  range  <>)  of  I tern; 
with  function  "<"  (Left  :  in  Item; 

Right  :  in  Item)  return  Booleein; 


package  Binary_Insertion_Sort  is 

procedure  Sort  (The_I terns  ;  in  out  Items) ; 
end  Binary_Insertion^Sort ; 


BINARY  INSERTION  SORT 
ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady 
Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

•Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3) 
(ii) 

—  of  the  rights  in  Technical  Data  and  Computer 

—  Software  Clause  of  FAR  52.227-7013,  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body  Binary_Insertion_Sort  is 

procedure  Sort  (The_Items  :  in  out  Items)  is 
Teoporary^Item  :  I  tern; 

Left_Index  ;  Index; 

Middle_lndex  :  Index; 

Right^Index  :  Index; 

begin 

for  Outer_Index  in  Index *Succ(The_Items' First) 
. .  The_I terns ' Last  loop 

Temporary_Item  ;=  The_I terns (Out er_Index) ; 
Left_lndex  :=  The_Items ’First ; 

Right_Index  :=  Outer_Index; 

while  Left_Index  <=  Right_Index  loop 


Middle_Index  : = 

Index  •  Val  ( ( Index  ■  Pos  ( Le  f  t„Index )  + 

Index  *  Pos (Right_Index) )  /  2 ) ; 

if  Temporary_Item  < 

The_I  terns  (Middl  e_Index )  then 

exit  when  ( Middl e_Index  = 

The_I terns ’First) ; 

Right_Index  := 

Index ' Pred(Middle_Index) ; 

else 

exit  when  {Middle_lndex  = 

Outer_Index) ; 

Left_Index  := 

Index ’ Succ ( Middl e_Index) ; 

end  if; 
end  loop; 

if  Left_lndex  /=  Outer_Index  then 

The_I terns ( Index ' Succ (Lef t_Index) 

Outer_lndex )  : = 

The_I terns  (Lef  t_Index  . . 

Index 'Pred(Outer_Index) ) ; 

The_I terns ( Le f t_Index )  : = 

Temporary_Item; 

end  if; 
end  loop; 
end  Sort ; 

end  Binary_Insertion_Sort ; 


BINARY  INSERTION  SORT 
PSDL 


OPERATOR  Sort 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TirPE, 

Index  :  DISCRETE_TyPE, 

Items  :  ARRAY [ARRAY_ELEMENT  :  Item,  ARRAY_INDEX 
Index] , 

func_"<"  :  FUNCTION[Left  :  Item,  Right  :  Item, 
RETURN  :  Boolean] 


INPUT 

The_Items  :  Items 
OUTPUT 

The_I terns  :  Items 

END 

IMPLEMENTATION  ADA  Sort 
END 
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BUBBLE  SORT 


ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 
type  Index  is  (<>) ; 

type  Items  is  array  {Index  r^ge  <>)  of  Item; 
with  function  "<“  (Left  :  in  Item; 

Right  :  in  Item)  return  Boolean; 


package  Bxibble_Sort  is 

procedure  Sort  (The_ltems  :  in  out  Items); 
end  Bubble_Sort; 


BUBBLE  SORT 

ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady 
Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  siabject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3) 
(ii) 

—  of  the  rights  in  Technical  Data  and  Computer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 
--  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body  Bubble_Sort  is 

procedure  Sort  (The_Items  :  in  out  Items)  is 
Teirporary_Item  ;  Item; 

Exchanges_Made  :  Boolean; 
begin 


for  Outer_Index  in  Index' Succ(The_I terns ’First) 
..  The_Items’Last  loop 

Exchange s_Made  :=  False; 

for  Inner_Index  in  reverse  Outer_Index  . . 
The_I terns 'Last  loop 

if  The_I terns (Inner_Index)  < 

The_I terns  (Index '  Pred{Inner_Index) ) 

then 

Exchanges_Made  True; 
Terrporary_Item  :  = 

The_Items  ( Index  ’  Pred  ( Inner_Index ) )  ; 

The_I terns ( Index • Pred ( Inner_Index) ) 

The_Items (Inner_Index) ; 

The_I terns ( Inner_Index )  : = 

Teitporary^I  tern ; 

end  if; 
end  loop; 

exit  when  not  Exchanges_Made ; 
end  loop; 
end  Sort; 

end  B\ibble_Sort ; 


BUBBLE  SORT 
PSDL 


OPERATOR  Sort 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TyPE, 

Index  :  DISCRETE_TYPE , 

Items  :  ARRAY  IARRAY_ELEMENT  :  Item,  ARRAY_INDEX 
Index] , 

func_"<"  :  FUNCTION [Left  :  Item,  Right  :  Item, 
RETURN  ;  Boolean] 


INPUT 

The_I terns 
OUTPUT 

The_I  terns 

END 


Items 

Items 


IMPLEMENTATION  ADA  Sort 
END 
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HEAP  SORT 


ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 
type  Index  is  (<>) ; 

type  Items  is  array  (Index  range  <>)  of  Item; 
with  fimction  '<•  (Left  :  in  I  tern; 

Right  :  in  Item)  return  Boolean; 


package  Heap_Sort  is 

procedure  Sort  {The_I terns  :  in  out  Items) ; 
end  Heap_Sort; 


HEAP  SORT 

ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady 
Booch 

—  All  Rights  Reserved 

—  Serial  Nxiinber  0100219 

•Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  siibdivision  (b)  (3) 
(ii) 

—  of  the  rights  in  Technical  Data  and  Computer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body  Heap_Sort  is 

procedure  Sort  (The_Items  :  in  out  Items)  is 

Teinporary_Item  :  Item; 

Left_Index  :  Index; 

Right_Index  :  Index; 

procedure  Sift  (Left_Index  :  Index; 

Right_Index  :  Index)  is 
Tenporary_Item  :  Item  :  = 

The_I terns (Left_Index) ; 

The_Front  :  Index  :=  Left_Index; 

The_Back  :  Index  ; = 

Index  * Va 1 ( Index ' Pos ( The_Fr on t )  *  2) ; 
begin 

while  The_Back  <=  Right_Index  loop 
if  The_Back  <  Rights Index  then 
if  The_ltems(The_Back)  < 

The_I terns (Index ' Succ (The_Back) ) 

then 

The_Back  :  = 

Index' Succ (The^Back) ; 


end  if; 
end  if; 

exit  when  not  (TemporarY_Item  < 

The_I terns {The_Back) ) ; 

The_l terns ( The_Front )  : = 

The_I  terns  (The_Back)  ; 

The_Front  ;=  The_Back; 
exit  when  (Index' Pos {The_Fr on t)  *  2  > 
Index ' Pos ( The_I terns  *  Las  t ) ) 

The_Back  : = 

Index ’ Val ( Index ' Pos { The_Front )  *  2 ) ; 
end  loop; 

The_Items(The_Front)  :=  Temper  ary_I  tern; 
end  Sift; 

begin 

Left_Index 

Index '  Val  { ( ( Index '  Pos  ( 'rhe_I  terns  ‘  Las  t )  - 

Index' Pos ('Ihe_Items‘ First)  1) 

2)  +  1); 

High t_Index  : =  The_I terns ‘ Las  t ; 
while  Left_Index  >  The_Itert\s 'First  loop 
Lef t_Index  ; =  Index ' Pred { Le  f  t_lndex ) ; 

S i f t ( Le  f t_Index ,  Righ t_Index ) ; 
end  loop; 

while  Right_Index  >  The_I terns 'First  loop 
Terrporary_Item  :  = 

The_I terns (The^Items ' First) ; 

The_ltems(The_Items ’First)  := 

The_Items (Right_Index) ; 

The_l  terns  ( Righ  t_Index)  ;=  Terrporary_Item; 
High t_Index  : =  Index ' Pr ed ( Righ t_Index ) ; 
Sift (Lef t_Index,  Right_Index) ; 
end  loop; 
end  Sort; 

end  Heap_Sort; 


HEAP  SORT 
PSDL 


OPERATOR  Sort 
SPECIFICATION 
GENERIC 

Item  ;  PRIVATE_TyPE, 

Index  :  DISCRETE^TYPE, 

Items  :  ARRAY  [ARRAy_ELEMENT  :  Item,  AERAY_INDEX 
Index] , 

func_"<"  :  FUNCTION[Left  ;  Item,  Right  :  Item, 
RETURN  ;  Boolean] 


INPUT 

The_Items  :  Items 
OUTPUT 

The_Items  ;  Items 

END 

IMPLEMENTATION  ADA  Sort 
END 
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NATURAL  MERGE  SORT 


generic 
type 
type 
with 
File)  ; 

with 
File)  ; 

with 

File; 

Item)  ; 

with 

File; 

Item) ; 

with 
File)  ; 


Item  is  private; 


procedure  Open_For^Reading 

(The_File 

;  in 

out 

procedure  Open_For_Writing 

(The_File 

:  in 

out 

procedure  Get 

(The^File 

:  in 

out 

The_Item 

;  out 

procedure  Put 

(The^File 

;  in 

out 

The_Item 

;  in 

procedure  Close 

(The_File 

:  in 

out 

ADA  SPECIFICATIONS 

with  function  Next_Item 
return  Item; 

with  function  •<• 


return  Boolean; 


return  Boolean; 

package  NaturalJMerge^Sort  is 

procedure  Sort  (The_File 


File_Is_Enipty  :  exception; 
end  Natural_flerge_Sort; 


(The_File  : 

in  File) 

(Left  : 

Right  : 

in  Item; 
in  Item) 

(The^File  : 

in  File) 

:  in  out 
e_l  :  in  out 
e_2  :  in  out 

File; 
File; 
File)  ; 

NATURAL  MERGE  SORT 


ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady 
Booch 

—  All  Rights  Reserved 


—  Serial  Number  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3) 

(ii) 

—  of  the  rights  in  Technical  Data  and  Computer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body  Natural_Merge_Sort  is 

procedure  Sort  (The_File  :  in  out  File; 

Teit53orary_File_l  :  in  out  File; 
Temporary_File_2  ;  in  out  File)  is 

Nuinber_Of_Runs  ;  Natural; 

procedure  Copy  {From_The_File  :  in  out  File; 

To_The_File  :  in  out  File; 

End_Of_R\m  :  out  Boolean) 

is 

Temporary^! tern  :  I tern; 
begin 

Get  ( Frorn_The_File ,  Teirporary_I tern )  ; 

Put  (To_The_File,  Teitporary_Item)  ; 
if  Is_End_Of_File(From_The_File)  then 
End_Of_Run  :=  True; 

else 

End_0  f _Rxan  :  =  { Nex t_I  t em  ( Pr om_The_Fi  le ) 
<  Teii?>orary_Item)  ; 

end  if; 
end  Copy; 


procedure  Copy_Run  (From_The_File  :  in  out 

File; 

To_The_File  :  in  out 

File)  is 

End_Of_Run  :  Boolean; 
begin 

loop 

Copy { From_The_File ,  To_The_File , 

End_Of_Run)  ,- 

exit  when  En<LOf_Run; 
end  loop; 
end  Copy_Rxxn; 


File; 


procedure  Merge_Run  (Fron\_The_File  :  in  out 
And_The_File  ;  in  out 


To_The_File  :  in  out 

File)  is 

End_Of_Run  :  Boolean; 
begin 

loop 

if  not  (Next_Item{And_The_File)  < 

Next_I tem ( From_The_Fi le ) )  then 
Copy  (Froii\_The_File ,  To_The_File , 

End_0f_Run) ; 

if  End_Of_Run  then 

Copy_Run { And_The_File , 

To_The_File) ; 

exit; 
end  if; 


else 

Copy ( And_The_File ,  To_The_File , 

End_0f_Run) ; 

if  EndLOf_Run  then 

Copy_Run ( FronuThe_File , 

To_The_File) ; 

exit; 
end  if; 
end  if; 
end  loop; 
end  Merge_Rvm; 


begin 

loop 

Open_For_Reading(The_File) ; 
if  Is_End_Of_File(The_File)  then 
Close(The_File); 

Close  (Tejiporary_File_l)  ; 
Close  (Teotporary_File_2 )  ; 
raise  File„Is_Einpty; 


else 

Open_For_Wri ting (Tenporary_File_l ) ; 
Open_For_Writing(Ten55orary_File_2)  ; 

loop 

Copy_Run(The_File,  To_The_File  => 


Ternporary_File_l)  ; 


if  not  Is_End_Of_File (The_File) 


CopyJR\an{The_File,  To_The_File 

=>  Teiiporary_File_2) ; 

end  if; 

exit  when  Is_End_Of_File (The_File) ; 
end  loop; 

Open_For_Writing{The_File) ; 
Open_For_Reading{Temporary_File_l) ; 
Open_For_Reading(Temporary_File_2) ; 
Number_Of JRuns  :=  0; 
while  (not 

Is_End_Of_File  (Teiiporary_File_l ) )  and 
(not 

Is_End_Of_File  {Teirporary_File_2 ) )  loop 

Merge_Run  (Teirporary_File_l , 


Tenporary_File_2 , 


To^The^File  =>  The_File) ; 
NxOTber_Of_Runs  :=  Number_Of_Runs  + 


1; 

end  loop; 
while  not 

Is_EndLOf_File (Tenporary_File_l)  loop 

Copy_Riin  ( Teinporary_File_l , 
To_The_File  =>  The_File) ; 

Number_Of_Rxms  :=  Number_Of_Runs  + 


1; 

end  loop; 
while  not 

Is_End_Of_File  (Teo?3orary_File_2 )  loop 

Copy_Rtin(Teinporary_File_2 , 
To_The_File  =>  The_File) ; 

Number_Of_Runs  :=  Nuinber_Of_Runs  + 

1; 

end  loop; 

exit  when  (Nuiriber_Of_Runs  =  1); 
end  if; 
end  loop; 

Close (The^File) ; 

Close  (Teirporary_File_l) ; 

Close ( Temper ary_File_2 ) ; 
end  Sort; 


end  Na tura l_Merge_Sor t ; 
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NATURAL  MERGE  SORT 


OPERATOR  Sort 
SPECIFICATION 
GENERIC 

Item  ;  PRIVATE_TyPE, 

File  ;  PRIVATE^TyPE, 

Open_For_Reading  :  PROCEDURE  [The_File  :  in_out[t  : 
File]], 

Open_For_Writing  :  PROCEDURE [The_File  :  in_out[t  : 
File]], 

Get  :  PROCEDURE [The^File  ;  in_out[t  :  File], 
The_Item  :  out[t  :  Item]], 

Put  :  PROCEDURE I The^File  :  in_0utlt  :  File], 
The^Item  :  in[t  :  Item]], 

Close  :  PROCEDURE [The_File  :  in_out[t  ;  File]], 
Next_Item  :  FUNCTION  I  The_File  :  File,  RETURN  : 
Item] , 

func_-<-  :  FUNCTION  [Left  :  Item,  Right  :  Item, 
RETURN  :  Boolean] , 


PSDL 


Is_EncLOf_File  :  FUNCTION [The^File  :  File,  RETURN 
Boolean] 

INPUT 

The_Pile  :  File, 

Temporary_File_l  :  File, 

Temper ary_File_2  :  File 
OUTPUT 

The_File  ;  File, 

Terrporary_File_i  :  File, 

Teirporary_File_2  :  File 
EXCEPTIONS 

File_Is_Ertpty 

END 

IMPLEMENTATION  ADA  Sort 
END 
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ORDERED  SEQUENTIAL  SEARCH 
ADA  SPECIFICATIONS 


generic 

type  Key  is  limited  private; 
type  Item  is  limited  private; 
type  Index  is  (<>) ; 

type  Items  is  array (Index  range  <>)  of  Item; 
with  function  Is^Equal  (Left  :  in  Key; 

Right  :  in  Item)  return 


—  adding  procedures  to  replace  functions 


procedure  Location_Of 


(The^Key 
In_The_I  terns 
Result 


in  Key; 
in  Items; 
out  Index) ; 


end  of  modification 


Boolean; 

with  fxmction  Is_Less_Than  (Left 
Right 

Boolean; 

package  0rderecLSe<3uential_Search  is 


in  Key; 

in  Item)  return 


function  Location_Of 
return  Index; 


(The^Key  :  in  Key; 

ln_The_Items  :  in  Items) 


IteituNot_Found  :  exception; 


—  modified  by  Tuan  Nguyen 

—  20  Jan  95 


end  Ordered_Sequential_Search; 


ORDERED  SEQUENTIAL  SEARCH 
ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989.  1990  Grady 
Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

_ restrictions  as  set  forth  in  sribdivision  (b)  (3) 

--  of  the  rights  in  Technical  Data  and  Conputer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body  Ordered_Se<iuential_Search  is 

—  modified  by  Tuan  Nguyen 

—  20  Jan  95 

—  adding  procedures  to  replace  ftinctions 

procedure  Location_Of  (The_Key  :  in  Key; 

In_The_I terns  :  in  Items; 


Result  :  out  Index)  is 

begin 

Result  Location_0f {The_Key,In_The_I terns ) ; 
end  Location_0f ; 

—  end  of  modification 

function  Location_0f  (The_Key  ;  in  Key; 

In_The_I terns  :  in  Items) 

return  Index  is 
begin 

for  The_Index  in  In_The_I terns 'Range  loop 
if  Is_Equal(The_Key, 

In_The_I terns (The_Index) )  then 

return  The_Index; 
elsif  Is__Less_Than  ( The_Key , 

In_The_I  terns  {The_Index)  }  then 

raise  Item_Not_Found; 
end  if; 
end  loop; 

raise  IteiT\JJot_Found; 
end  Location_Of; 

end  Ordered_Sequential_Search; 


ORDERED  SEQUENTIAL  SEARCH 
PSDL 


OPERATOR  Location_Of 
SPECIFICATION 
GENERIC 

Key  :  PRIVATE^TYPE, 

Item  :  PRIVATE_TyPE, 
index  ;  DISCRETE_TyPE, 

Items  :  ARRAY [ARRAY_ELEMENT  :  Item,  ARRAY_INDEX  : 
Index] ,  .  ^ 

Is_Equal  :  FUNCTION[Left  :  Key,  Right  :  Item, 
return  :  Boolean]  ,  .  ^ 

Is_Less_Than  :  FUNCTION[Lef t  :  Key,  Right  :  Item, 
RETURN  :  Boolean] 


INPUT 

The_Key  :  Key, 

In_The_I terns  :  Items 
OUTPUT 

Result  :  Index 
EXCEPTIONS 

I  tem_No  t_Found 

END 

IMPLEMENTATION  ADA  Location_Of 
END 
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POLYPHASE  SORT 


ADA  SPECIFICATIONS 


generic 

Nuinber_Of_Files  :  in  Positive; 


type 

Item  is  private; 

type 

File  is  limited  private; 

with 

proced\ire  Open_For_Reading 

(The_File 

:  in 

out 

File) ; 

:  in 

with 

procedure  Open_For_Writing 

(The_File 

out 

File) ; 

(The_File 

:  in 

with 

procedure  Get 

out 

File; 

The_Item 

:  out 

Item)  ; 

(The_File 

in 

with 

procedure  Put 

out 

File; 

The_Item 

in 

Item)  ; 

with 

procedure  Close 

(The_File 

in 

out 

with  function  Next_Item  (FronL.The_File  :  in 

File)  return  Item; 

with  function  "<•  (Left  ;  in 

I  tern; 

Right  :  in 

Item)  return  Boolean; 

with  function  Is_EncLOf_File  {The_File  :  in 

File)  return  Boolean; 
package  Polyphase_Sort  is 

type  Files  is  array  (1  ..  NuiTiber_Of_Files )  of  File; 

procedure  Sort  (The_File  :  in  out  File; 

Ten5)orary_Files  ;  in  out  Files; 

Sorted_File  :  out  Positive); 

File_Is_Enipty  :  exception; 

end  Polyphase_Sort; 


POLYPHASE  SORT 
ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady 
Booch 

—  All  Rights  Reserved 

—  Serial  Nximber  0100219 


•Restricted  Rights  Legend “ 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3) 

(ii) 

—  of  the  rights  in  Technical  Data  and  Computer 

—  Software  Clause  of  FAR  52.227-7013-  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 


package  bo<^  Polyphase_Sort  is 


is 


procedure  Sort  (The_File 

Teitpor  ary_Fi  les 
Sorted_File 


in  out  File; 
in  out  Files; 
out  Positive) 


Number_Of_Runs 
Nuirber_Of_Files )  of  Natural; 

Nuinber_0  f _Duinrt^_Runs 
N\jmb€r_0  f _F  i  les )  o  f  Natural  ; 
Last_Item 

Nuirb€r_Of_Files )  of  Item; 

Filejflap 

Number_Of_Files )  of  Positive; 

Available_Files 
Nturiber_Of_Files )  of  Positive; 
Level 

Output_File 

Number^Of^vai  lable^Files 

Last_^File 

Last^Runs 

Las  t_Duirany_Runs 


array  (1  . . 

array  (1  . - 

array  (1  . . 

array  (1  . . 

array  (1  . . 

Natural  :=  1; 
Natural  :=  1; 
Natural; 
Positive; 
Natural ; 
Natural; 


procedure  Select__File  is 

Temporary^Rvin  :  Natural  ; 
begin 

if  Nuinber_Of_Dummy_Runs  (Output_File)  < 
Number_Of_Dumnv__Runs  (Output^File  +  1) 

then 

Output_Pile  :=  Output_File  +  1; 

else 

if  N\iinber_Of_Duinmy_Runs  (Output_File)  = 

0  then 

Level  :=  Level  +  1; 

Teinporary_R\in  :  =  Nimiber_Of_R\ms  { 1 ) ; 
for  Index  in  1  . .  (Nuitber_Of_Files 


-  1)  loop 

Number_Of  JDuinn^^Runs  ( Index )  :  = 

Tenporary_Run  + 
Number_Of_Runs ( Index  +1)  - 

Number_Of_Runs (Index) ; 
Nuinber_0  f _^uns  ( Index )  : 
Temporary_Run  + 

Number _Of _Runs ( Index  +1); 

end  loop; 
end  if; 

Output_File  :=  1; 
end  if; 

Nximber^Of _Dumtny_Riins  ( Ou tpu t_Fil  e )  : « 
N\i(nber_Of _Dumirv_Runs  ( Output_F  i  le )  -  1  ; 
end  Select_File; 


procedure  Copy_Run  is 

TeiiT)orary_Item  :  Item; 
begin 

loop 

Get (The_File,  Tenporary_Item} ; 

Put (Tenporary_Files (Output_File) , 

Temporary_Item) ; 

exit  when  (Is_End^Of_File(The_.File}  or 

else 

{Next_ltem(The_File)  < 

Ten55orary_Item) )  ; 

end  loop; 

Last_Item{Output_File)  :=  Teit5>orary_Item; 
end  Copy_Run; 


procedure  Merge_Run  is 

File_Index  :  Positive; 

Smal les t_I tern  :  Item; 

Smallest^File  :  Positive ; 

Tenporary_ltem  :  Item; 

EncLOf_File  :  Boolean; 
begin 

loop 

Number_Of_jAvailable_Files  ;  =  0 ; 

for  Index  in  1  . ,  (Number_Of_Files  -  1) 

loop 

if  Niamber_Of_Dummy_Runs (Index)  >  0 

then 

Nuirber_Of_Dumttiy_Rtans  ( Index)  :  = 
N\imb€r_Of_Dumitv_Runs  (Index)  - 


1; 


1; 


Number^Of _Avai lable^F i 1 es  : = 
Nvimber_Of^vailable_Files 


Available^Files  (Number_Of^vailable_Files )  :  = 

Fi le JMap ( Index ) ; 
end  if; 
end  loop; 

if  Number_Of_Available_Files  =  0  then 

Nxamber^Of _.Duinmy_R\ms  ( Number_0  f _Fi  les )  :  = 

Number_OfJDuinitry_Runs  (Number_Of_Files)  +  1; 
else 

loop 

File_Index  :=  1; 

Sinallest_File  :=  1; 
Smallest_Item  := 

Next_Item 


(Temporary_Files(Available_Files(l) ) )  ; 

while  File_Index  < 
Number_Of_Available_Files  loop 

File_Index  ;=  File_Index  + 


1; 


Teinporary_I  tern 
Next_Item 


(Tenporary_Files  (Available_Files  (File_Index) ) )  ; 

if  Teitporary_Item  < 

Smallest_Item  then 

Smallest_ltem  := 

Tenporary_I  tem ; 

Smallest_File  :® 

File_Index; 

end  if; 
end  loop; 
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Get  (Ten5)orary_Files  (Avaiiable^Files  {Smallest_File) ) , 
Tennporary^Itein) ; 
En<3L0f_File  :  = 

Is_End_Of_File 

{Tenporary_Files (Available_Files (Smallest^File) ) ) ; 

Put  (TenDorary^Files  (File_J«ap  (Nuiriber_Of_Files ) ) , 
Tenipora^_Item) ; 
if  End_Of_File  or  else 
(Next^Item 

(Teitiporary_Files (Available_Files (Smallest_File) ) ) 

<  Temper ary_I tern)  then 

Available_Files (Smallest^File)  := 

Available_Files{Number_Of_Available_Files} ; 

Nuihber_Of  _Avai  1  ab  le__Fi  le  s 


Nuinber_Of_Available_Files  -  1; 

end  if; 
exit  when 

(Nuinl>er„Of^vailable_Files  =  0); 

end  loop; 
end  if; 

Last^Runs  :=  Last_Runs  -  1; 
exit  when  (Last^Runs  =  0) ; 
end  loop; 
end  Merge_Run; 


for  Index  in  1  . .  {Nuinber_Of_Files  -  1)  loop 
Nuinber_0  f  _Runs  ( Index )  :  =  1 ; 

Niimber_0  f  _Dumnv_Runs  ( Index )  :  =  1 ; 
Open_For_Writing(Teit?)orary_Files( Index) )  ; 
end  loop; 

Number_Of_Runs  (Nuinber_Of_Files )  :  =  0  ; 

Number_Of_Diimrny_Runs  (Nuitiber_Of_Files)  0; 
Open^For_Reading { The_Fi le ) ; 
if  Is_End_Of_File(The_File)  then 

for  Index  in  1  . .  Nxmiber_Of_Files  loop 
Close  (Teinporary_Files  (Index) ) ; 
end  loop; 

Close (The^File) ; 
raise  File_Is_Enpty; 

else 

loop 

Select_File; 

Copy_Run; 

exit  when  (Is_En<l_Of_File{The_File)  or 
{Output_File  = 

(Nuinber_Of_Files  -  1 ) ) )  ; 

end  loop; 

while  not  Is_End_Of_File(The_File)  loop 
Select_File ; 

if  not  (Next_Item{The_File)  < 

Las t_I tern  {(Xitput_File) )  then 
Copy_Run; 

if  Is_End_Of_Pile(The_File)  then 


Number „0  f _Duinn^_Runs  ( Ou tpu t_Fi  le )  ;  = 

Nuinber_Of„Duininy_Runs{Output_File)  +  1; 
else 

Copy_Run ; 
end  if; 

else 

Copy„Run; 
end  if; 
end  loopy- 
close  (The^File)  ; 

for  Index  in  1  . .  {Nuinber_Of_Files  “  1 ) 

loop 

Open_For_Reading(Teniporary_Files (Index) )  ; 

end  loop; 

for  Index  in  1  . .  N\jmber„Of_Files  loop 
Fi le_Map ( Index )  ; =  Index ; 

end  loopy- 
loop 

Last^Runs  : = 

Number_Of_R\ins  (Nuinber_Of_Files  -  1 )  ; 

Number_Of_Duininy-_Runs  (Number_Of_Files) 

:=  0; 

Open_For_Writing  (Tert^Jorary^Files  (File  Jlap  (Nuinber_Of_Fil 

es))); 

Merge_Run; 

Open_For_Reading  (Terrporary_Files  ( File_JMap  (Nuinber_Of_Fil 

^  ^ '  Last_File  :  =  FileJMap  (Nuinber_Of_Files)  ; 

Last_Duinnv-Rvins  :  = 

Number_Of_Dumrry_Rxms(Number_Of_Files)  ; 

*”  Last_Runs  :  = 

Number_Of__Runs  (Nuinber_Of_Files  -  1)  ; 

for  Index  in  reverse  2  . . 
Number_Of_Files  loop 

File_Wap( Index)  :=  FileJMap (Index  - 

1)  ; 

Number_0  f _Runs ( Index )  :  = 

Nuinber_Of_R\ins (Index  “1)  - 

Last„Runs; 

Nuiriber_Of _.Duintny_Runs  ( Index)  :  = 
Nuinber_Of_Dximmy_Rtins  (Index  -  1)  ; 
end  loop; 

Filejlap(l)  :=  Last^File; 
Nuinber_Of_Runs(l)  :=  Last_Runs; 
Niuiiber_Of  ^.Dumrtv'—R'ins  ( 1 )  :  = 

Last_DuiniivJRuns  ; 

Level  :=  Level  -  1; 
exit  when  (Level  =  0) ; 
end  loop; 

for  Index  in  1  . .  Number_Of_Files  loop 
Close (Temporary_Files ( Index) ) ; 
end  loop; 

Sorted^File  FileJIapd); 
end  if; 
end  Sort; 

end  Polyphase_Sort; 


POLYPHASE  SORT 
PSDL 


OPERATOR  Sort 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TYPE, 

File  :  PRIVATE_TTfPEy 

Open_For_Reading  :  PROCEDURE [The^File  ;  in_out[t  : 

^^^^Open_For_Writing  :  PROCEDURE tThe_File  :  in_out(t  : 

Get  :  PROCEDURE I The_File  ;  in_out[t  :  File), 
The_Item  :  out[t  :  Item]], 

Put  :  PROCEDURE [The_File  :  in_OUt[t  :  File], 
The^Item  :  in[t  :  Item]], 

Close  :  PROCEDURE [The_File  :  in_OUt[t  :  File]], 
Next_Item  :  FUNCTION [FronL.The_File  :  File,  RETURN  : 
Item] , 


func_"<*  :  FUNCTIONlLeft  :  Item,  Right  :  Item, 
RETURN  :”Boolean], 

IS_End_Of_File  :  FUNCTION (The^File  :  File,  RETURN 
Boolean] 

INPUT 

The_File  :  File, 

Tertporary_Files  :  Files 
OUTPUT 

The_File  :  File, 

Temporary_Files  :  Files, 

Sorted_File  :  Positive 
EXCEPTIONS 

File_Is_Empty 

END 

IMPLEMENTATION  ADA  Sort 
END 
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QUICKSORT 

ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 
type  Index  is  (<>) ; 

type  Items  is  array  (Index  range  <>)  of  I  tern  ; 
with  function  (Left  :  in  Item; 

Right  :  in  Item)  return  Boolean; 


package  Quick_Sort  is 

procedure  Sort  (The^I terns  ;  in  out  Items) ; 
end  Quick_Sort; 


QUICKSORT 


ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady 
Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 


"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3) 
(ii) 

—  of  the  rights  in  Technical  Data  and  Conputer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer; 

—  Wizard  software,  2171  S,  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body  Quick_Sort  is 


procedure  3Sxchange  (Left  ;  in  out  Item; 

Right  :  in  out  Item)  is 
Tenporary_Item  ;  I  tern; 
begin 

Temporary_Item  :=  Left; 

Left  :=  Right; 

Right  :  =  Teiiporary_Item; 
end  Exchange; 


procedure  Sort  {The_I terns  ;  in  out  Items)  is 
procedure  Sort_Recursive  (Left_Index  :  in 


Index; 


Right„Index  ;  in 


Index)  is 

Pivot_Item  :  Item; 

The_Front  :  Index; 

The_Back  ;  Index; 

Middle_Index  ;  Index; 

begin 

if  Left^Index  <  Right_Index  then 
Middle_lndex  := 

Index • Val ( ( Index • Pos ( Lef t_Index)  + 


Index ’ Pos (Right_Index) )  /  2 ) ; 

if  The_Items{Middle_Index)  < 

The_I terns ( Le f t_Index )  then 

Exchange  (The_I terns  (Middle,. Index) , 
The_I terns  (Lef  t^Index) )  ; 

end  if; 

if  The^Items (Right_Index)  < 

The_Items  (Lef t_Index)  then 

Exchange (The_I terns (Right^Index) , 
The_Items  (Lef  t_Index) )  ; 

end  if; 

if  The_Items(Right_Index)  < 

The_I  terns  (Middle_Index)  then 


Exchange  (The„Items  (Right_Index) , 
The_Items  (Middle_Index) )  ; 

end  if; 

Pivotal  tern  The_Items  (Middle_Index)  ; 
Exchange  (The,.Items  (Middle_Index) , 


The_I terns  (Index'  Pred(Right,..Index) ) ) ; 

The_Front  : =  Index • Succ ( Lef t_Index) ; 
The_Back  : =  Index ' Pred ( Right^Index ) ; 
if  The„Back  /=  The_I terns ‘First  then 
The_Back  :=  Index  * Pred (The_Back) ; 
end  if; 
loop 

while  The_I terns (The_Front)  < 

Pivot_Item  loop 

The_Front  : = 

Index ' Succ (The_Front ) ; 

end  loop; 

while  Pivotal tern  < 

The_I t ems ( The_Back )  loop 

The_Back  := 

Index ‘ Pred (The_Back) ; 

end  loop; 

if  The_Front  <«  The^Back  then 

if  (The_Front  =  The_I terns 'Last) 


or  else 
then 


(The_Back  =  The_I terns ' First) 
return; 

else 


Exchange (The_I terns (The^Front ) , 

The^Iteins  (The^Back) ) ; 

The_Front  := 

Index ' Succ ( The_Front ) ; 

The,^ack  :  = 

Index '  Pred(The..Back)  ; 

end  if; 
end  if; 

exit  when  (The_Front  >  The_Back) ; 
end  loop; 

Sort_Recursive(Left_Index,  The_Back) ; 
Sort_Recursive{The_Front,  Right_Index) ; 
end  if; 

end  Sort_Recursive ; 
begin 

Sort_Recursive {The_I terns ' First, 

The_I terns 'Last) ; 
end  Sort; 

end  Quick_Sort; 


QUICKSORT 

PSDL 


OPERATOR  Sort 
SPECIFICATION 
GENERIC 

Item  ;  PRIVATE_nfPE, 

Index  :  DISCRETE_TYPE, 

Items  :  ARRAY  [ARRAY_ELEMENT  ;  Item,  ARRAY_INDEX 
Index] , 

func_"<"  :  FUNCTIONlLeft  :  Item,  Right  :  Item, 
RETURN  :  Boolean) 


INPUT 

The_Items  :  Items 
OUTPUT 

The_Items  :  Items 

END 

IMPLEMENTATION  ADA  Sort 
END 
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RADIX  SORT 


ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 
type  Index  is  (<>} ; 

type  Items  is  array {Index  range  <>)  of  Item; 

Number_Of_Key_Bits  :  in  Positive; 

with  function  Bit_Of  (The_Item  ;  in  Item; 


The^Bit  :  in  Positive) 

return  Boolean; 
package  Radix_Sort  is 

procedure  Sort  (The^Items  :  in  out  Items); 

end  Radi3;_Sort; 


RADIX  SORT 

ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady 
Booch 

—  All  Rights  Reserved 


—  Serial  Number  0100219 

“Restricted  Rights  Legend* 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3) 
(ii) 

—  of  the  rights  in  Technical  Data  and  Computer 

--  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body  Radix_Sort  is 


procedure  Sort  {The_Items  :  in  out  Items)  is 
procedure  Sort^Recursive  (Left_lndex  :  in 


Index; 


Right_Index  :  in 


Index ; 


Bit  :  in 


Positive)  is 

Temper ary_Le ft  ;  Index; 
Tenporary_Right  :  Index; 

Temper ary_I tern  :  Item; 
begin 

if  Right_Index  >  Left_Index  then 
Temporary _Le  ft  : =  Le f t_Index ; 
Tenporary^ight  ;=  Rights  Index; 
loop 

while  (not 

Bit_Of (The_Items(Teiiporary_Left)  ,  Bit))  and 
(Teirporary_Left  < 

Tenporary^Right)  loop 

Temporary_Left  := 

Index '  Succ  (Tenporary_,Lef  t )  ; 

end  loop; 


while 

(Bit_0f (The_Items (Temporary_Right) ,  Bit))  and 
(Teirporary_Left  < 

Temporary_Right)  loop 

Tenporary_Right  := 

Index ' Pr ed ( Temper ary_Right ) ; 

end  loop; 

Tenporary^Item  :  = 

The_I terns  (Teiiporary_Lef  t)  ; 

The_I terns ( Tenporary_Lef t )  :  = 
The_I terns {Temporary_Right)  ; 

The_I  terns  ( Teirporary_Righ  t )  :  = 


Temporary_I  tern; 

exit  when  ( Temper ary_Le ft  = 

Temporary_Right) ; 

end  loop; 

if  not  Bit_Of (The„I terns (Right_Index) , 

Bit )  then 

Teirporary_Right  :  = 

Index 'Succ ( Temper ary_Right) ; 

end  if; 

if  Bit  <  Number_Of_Key_Bits  then 
if  Temper ary_Right  > 

The^I terns 'First  then 

Sor t_Recurs ive 
(Left_Index, 

Index’ Pred(Tenporary_Right) ,  Bit  1); 

end  if; 

Sor t_Recur s ive 

( Temporary_Righ t ,  Righ t_Index , 


Bit  +  1) ; 


end  if; 
end  if; 

end  Sort_Recursive; 


begin 

Sort_Recursive(The_Iteins' First,  The_I terns  'Last, 
end  Sort; 


end  Radix_Sort; 


QUICKSORT 

PSDL 


OPERATOR  Sort 
SPECIFICATION 
GENERIC 

Item  ;  PRIVATE^IYPE, 

Index  :  DISCRETE_TYPE, 

Items  :  ARRAY tARRAY^ELEMENT  :  Item,  ARRAY_INDEX 
Index] , 

Bit_Of  ;  FUNCTION [The_I tern  :  Item,  The_Bit  : 
Positive,  RETURN  :  Boolean] 


INPUT 

The_Items  :  Items 
OUTPUT 

The_I terns  :  Items 

END 

IMPLEMENTATION  ADA  Sort 
END 
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SEQUENTIAL  SEARCH 
ADA  SPECIFICATIONS 


generic 

type  Key  is  limited  private; 
type  Item  is  limited  private; 
type  Index  is  {<>) ; 

type  Items  is  array (Index  range  <>)  of  I tern; 
with  function  Is_Equal  (Left  :  in  Key; 

Right  :  in  Item)  return 

Boolean; 

package  Sequent ial_Search  is 


procedure  Location__Of 


(The^Key 
In_The_I  terns 
Result 


in  Key; 
in  I  terns; 
out  Index) ; 


—  end  of  modification 
function  Location_Of 
return  Index; 


(The_Key  :  in  Key; 

In_The_I terns  :  in  Items) 


—  modified  by  Tuan  Nguyen 

—  20  Jan  95 

—  adding  procedures  to  replace  functions 


ItenuNot_Found  :  exception; 
end  Sequent ial_Search; 


SEQUENTIAL  SEARCH 
ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady 
Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

•Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  sxabject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3) 

(ii) 

—  of  the  rights  in  Technical  Data  and  Coirputer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body  Sequential_Search  is 

—  modified  by  Tuan  Nguyen 

—  20  Jan  95 

—  adding  procedures  to  replace  fiinctions 

procedure  Location_0f  (The^Key  ;  in  Key; 


In_The_I terns  :  in  Items; 
Result  :  out  Index)  is 

begin 

Result  :  =  Location_0f  (The_Key,  In_The_I terns ) ; 
end  Location^Of; 

—  end  of  modification 

function  Location_Of  (The^Key  :  in  Key; 

In_The_I terns  :  in  Items) 

return  Index  is 
begin 

for  The^lndex  in  In_The_I terns ' Range  loop 
if  Is_Equal(The_Key, 

In_The_I terns ( The_Index ) )  then 

return  The_Index; 
end  if; 
end  loop; 

raise  Item_Not_Found; 
end  Location_Of ; 

end  Sequent ial^Search; 


SEQUENTIAL  SEARCH 
PSDL 


OPERATOR  Location_Of 
SPECIFICATION 
GENERIC 

Key  :  PRIVATE.TYPE, 

Item  ;  PRIVATE.TyPE, 

Index  :  DISCRETE^TYPE, 

Items  :  ARRAY  rARRAY_ELEMENT  :  Item,  ARRAY_INDEX 

Index] , 

Is_Equal  ;  FUNCTION  [Left  ;  Key,  Right  :  Item, 
RETURN  :  Boolean] 

INPUT 


The_Key  :  Key, 

In_The_I terns  :  Items 
OUTPUT 

Result  :  Index 
EXCEPTIONS 

1 1  emJ^o  t_Found 

END 

IMPLEMENTATION  ADA  Location„Of 
END 
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SHAKER  SORT 


ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 
type  Index  is  (<>} ; 

type  Items  is  array (Index  range  <>)  of  Item; 
with  function  "<"  (Left  :  in  Item; 

Right  :  in  Item)  return  Boolean; 


package  Shaker_Sort  is 

procedure  Sort  (The_I terns  :  in  out  Items) ; 
end  Shaker_Sort; 


SHAKER  SORT 

ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady 
Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  sxibdivision  (b)  (3) 
(ii) 

—  of  the  rights  in  Technical  Data  and  Computer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 


package  body  Shaker_Sort  is 


procedure  Sort  (The_I terns  :  in  out  Items)  is 
Teitporary^Item  :  I  tern; 

Teiiporary__Index  :  Index ; 

Left_Index  :  Index; 

Right_Index  :  Index ; 

begin 

Le  f  t_Index  : =  Index ' Sue c ( The_I terns ‘First); 

Right_Index  :=  The_I terns ‘Last; 

loop 

for  Middle_Index  in  reverse  Left_Index  . . 
Right_Index  loop 

if  The_Items (Middle_Index)  < 

The_I terns ( Index ‘ Pred (Middle_Index) ) 


then 


Temper ary_I tern 

The_Items (Index 'Pred (Mi ddle_Index) ) ; 

The_I  terns  ( Index  ’  Pred  (Middle_Index) ) 

The_I  terns  (Middle_Index)  ; 

The_I terns { Middle_Index )  : = 

Terrporary„I  tem ; 

Teirporary_Index  :=  Middle_Index; 
end  if; 
end  loop; 

Left_Index  :=  Index 'Succ( Temper ary_Index) ; 
for  Middle^Index  in  Lef t^Index  . . 
Right_Index  loop 

if  The_I terns  (Middle^Index)  < 

The_I terns  ( Index '  Pred  (Middle_Index} ) 

then 

Temper ary_I tem  : = 

The_Items( Index* Pred {Middle_Index) ) ; 

The_Items ( Index • Pred (Middle^Index) ) 

The_I  terns  {Middle_Index)  ; 

The_I  terns  (Middle_Index)  :  = 

Tertpor  ary_I  t  em ; 

Teirporary_Index  :=  Middle_Index; 
end  if; 
end  loop; 

Right_Index  : =  Index ‘ Pred ( Temporary_Index) ; 
exit  when  (Left_Index  >  Right_Index) ; 
end  loop; 
end  Sort; 

end  Shaker_Sort; 


SHAKER  SORT 
PSDL 


OPERATOR  Sort 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE^TYPE, 

Index  :  DISCRETE^TYPE, 

Items  :  ARRAY  [ARRAY_ELEMENT  :  Item,  ARRAY_INDEX 
Index) , 

func_‘<"  :  FUNCTION  [Left  :  Item,  Right  ;  Item, 
RETURN  :  Boolean) 


INPUT 

The_Items  :  Items 
OUTPUT 

The_I terns  :  Items 

END 

IMPLEMENTATION  ADA  Sort 
END 
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SHELL  SORT 


ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 
type  Index  is  (<>) ; 

type  Items  is  array (Index  range  <>)  of  I tern; 
with  fxinction  "<“  (Left  :  in  Item; 

Right  :  in  Item)  return  Boolean; 


package  Shell_Sort  is 

procedure  Sort  (The_Items  ;  in  out  Items) ; 
end  Shell_Sort; 


SHELL  SORT 

ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady 
Booch 

—  All  Rights  Reserved 

—  Serial  Nurciber  0100219 

"Restricted  Rights  Legend* 

—  Use,  duplication,  or  disclosure  is  siibject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3) 
(ii) 

—  of  the  rights  in  Technical  Data  cind  Conputer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body  Shell_Sort  is 

procedure  Sort  {The_I terns  :  in  out  Items)  is 
Ten5>orary_Item  :  I  tern; 

Inner_Index  :  Index; 

Increment  :  Positive  1; 

begin 

loop 

exit  when  (({9  *  Increment)  +  4)  >= 

( Index ’Pos(The_I terns 'Last)  - 
Index ' Pos (The^Items ' First)  +  1) ) ; 

Increment  :=  (3  *  Increment)  +  1; 
end  loop; 
loop 

for  Outer_Index  in 


Index ‘ Val ( Index ' Pos ( The_I terns ‘ First )  + 

Increment )  . . 

The_I terns 'Last  loop 
Teii5>orary_Item  :  = 
The_Items(Outer_lndex)  ; 

Inner_Index  :=  Outer_Index; 
while  Teirporary_Item  < 

The_I terns ( Index • Val ( Index ' Pos ( Inner_Index )  - 
Increment) ) 

loop 

The_I terns ( Inner^Index )  ; = 


The_I t  ems ( Index ' Val ( Index ' Pos ( Inner_Index )  - 
Increment) ) ; 

Inner_Index  : = 

Index  *  Val { Index • Pos ( Inner_Index ) 


-  Increment)  ; 


exit  when  ( Index ' Pos ( Inner_Index )  - 


Increment  < 


Index ' Pos (The_Items ' First) ) ; 

end  loop; 

The_I terns ( Inner_Index )  : = 

Teinporary_Item; 

end  loop; 

exit  when  (Increment  =1); 
Increment  :=  (Increment  -  1)  /  3; 
end  loop; 
end  Sort; 


end  Shell^Sort; 


SHELL  SORT 
PSDL 


OPERATOR  Sort 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE^TYPE, 

Index  :  DISCRETE.IYPE, 

Items  :  ARRAY  [ARRAY^ELEMENT  ;  Item,  ARRAY^INDEX 
Index) , 

func_“<"  :  FUNCTIONtLeft  :  Item,  Right  :  Item, 
RETURN  :  Boolean] 


INPUT 

The^Items  :  Items 
OUTPUT 

The_Items  :  Items 

END 

IMPLEMENTATION  ADA  Sort 
END 
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STRAIGHT  INSERTION  SORT 


ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 
type  Index  is  (<>) ; 

type  Items  is  array (Index  range  <>)  of  Item; 
with  function  "<"  (Left  :  in  Item; 

Right  :  in  Item)  return  Boolean; 


package  Straight_Insertion_Sort  is 

procedure  Sort  (The_Items  :  in  out  Items); 
end  Straight_Insertion_Sort; 


STRAIGHT  INSERTION  SORT 
ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady 
Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

—  "Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3) 
(ii) 

—  of  the  rights  in  Technical  Data  and  Coirputer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body  Straight_Insertion_Sort  is 

procedure  Sort  {The„I terns  :  in  out  Items)  is 
Temporary_Item  :  Item; 


Inner_Index  :  Index; 
begin 

for  Outer_Index  in  Index • Succ (The_Items ' First) 
..  The_I terns 'Last  loop 

Tenporary^Item  :=  The_Iteins(Outer_Index)  ; 
Inner_Index  ;=  Outer_Index; 
while  Teitporary_Item  < 

The_I terns ( Index ' Pred { Inner_Index) )  loop 

The_I terns ( Inner_Index )  : = 

The„I terns ( Index • Pred ( Inner_Index) ) ; 

Inner_Index  : =  Index ' Pred ( Inner_Index ) 
exit  when  (lnner_Index  = 

The_Items ' First) ; 

end  loop; 

The_Items{Inner_Index)  :=  Temporary_ltem; 
end  loop; 
end  Sort; 

end  Straight_Insertion_Sort ; 


STRAIGHT  INSERTION  SORT 
PSDL 


OPERATOR  Sort 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TyPE, 

Index  :  DISCRETE_TYPE, 

Items  :  ARRAY  [ARRAY_ELEMENT  :  Item,  ARRAY_INDEX 
Index] , 

func_"<"  :  FUNCTIONILeft  :  Item,  Right  :  Item, 
RETURN  :  Boolean] 


INPUT 

The_I terns  :  Items 
OUTPUT 

The_I terns  :  Items 

END 

IMPLEMENTATION  ADA  Sort 
END 
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STRAIGHT  SELECTION  SORT 


ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 
type  Index  is  (<>) ; 

type  Items  is  array (Index  range  <>)  of  Item; 
with  function  "<"  (Left  :  in  Item; 

Right  :  in  Item)  return  Boolean; 


package  Straight_Selection_Sort  is 

procedure  Sort  {The_Items  :  in  out  Items); 
end  Straight_Selection_Sort; 


STRAIGHT  SELECTION  SORT 


ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady 
Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

•Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3) 

(ii) 

—  of  the  rights  in  Technical  Data  and  Conputer 

—  Software  Clause  of  FAR  52,227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body  Straight_Selection«Sort  is 

procedure  Sort  (The_Items  ;  in  out  Items)  is 
Temper  ary_I  tern  :  I  tern; 

Tenporary_Index  :  Index; 


begin 

for  Outer_Index  in  The_I terns ' First  .. 

Index ’Preddhe^I terns ‘Last)  loop 

Tenporary_Index  :=  Outer_Index; 
Tenporary^Item  :=  The^I terns  (Outer _Index)  ; 
for  lnner_Index  in  Index ' Sue c (Out er_Index) 
..  The_I terns 'Last  loop 

if  The^Items (Inner_Index)  < 

Temper ary_I tern  then 

Temper ary_Index  :=  Inner_Index; 
Tertporary_ltem  :  = 

The_Items (Inner_Index) ; 

end  if; 
end  loop; 

The_Iteins  ( Tenporary_Index)  :  = 

The_I terns (Out er_Index) ; 

The_I  terns  (Outer_Index)  :=  Teitporary_Item,- 
end  loop; 
end  Sort; 

end  Straight_Selection_Sort; 


STRAIGHT  SELECTION  SORT 


PSDL 


OPERATOR  Sort 
SPECIFICATION 
GENERIC 

Item  ;  PRIVATE_TyPE, 

Index  :  DISCRETE^TyPE, 

Items  :  ARRAY  [ARRAY_ELEMENT  :  Item,  ARRAY_INDEX 
Index) , 

func_"<"  :  FUNCTION[Left  :  Item,  Right  ;  Item, 
RETURN  :  Boolean) 


INPUT 

The_I terns  :  Items 
OUTPUT 

The_I terns  ;  Items 

END 

IMPLEMENTATION  ADA  Sort 
END 
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STACK  0JB3  SPECIFICATION 


obj  STACK [X  : :  TRIV]  is  sort  Stack  . 
protecting  NAT  . 

***  constructors 


op  create 

:  ->  Stack  . 

op  copy 

;  Stack  Stack  ->  Stack 

op  clear 

;  Stack  ->  Stack  . 

op  push 

:  Elt  Stack  ->  Stack  . 

op  pop 

:  Stack  ->  Stack  . 

r  accessors 

op  isequal 

;  Stack  Stack  ->  Bool  . 

op  depthof 

:  stack  ••>  Nat  . 

op  isen^ty 

:  Stack  ->  Bool  . 

op  topof 

:  Stack  ->  Elt  . 

***  exceptions 

op  overflow  :  ->  Stack  . 


op  underflow  :  -->  Stack  . 
op  underflow  ;  ->  Elt  . 

***  variables  declaration 

var  S  SI  ;  Stack  . 
var  E  El  :  Elt  . 

***  axioms 

eq  clear (S)  =  create  . 
eq  copy {S, SI)  =  S  . 
eq  pop  (create)  =  xinderflow  . 
eq  pop (push (E, S) )  =  S  . 
eq  isequal (S,S1)  =  S  =«  SI  . 

eq  depthof(S)  s=  if  S  ==  create  then  0  else  1  +  depthof  (pop  (S) )  fi  . 
eq  isempty(S)  =  if  S  ==  create  then  true  else  false  fi  . 
eq  topof (create)  =  underflow  . 
eq  topof (push(E,S) )  =  E  . 

endo 
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STACK  PROFILE  CODES 


OPERATORS 

SIGNATURES 

PROFILE  CODES 

COPY 

AB->B 

3211 

CLEAR 

A->A 

2201 

PUSH 

AB->B 

3211 

POP 

A->A 

2201 

IS_EQUAL 

AB->C 

330 

DEPTH.OF 

A->B 

220 

IS.EMPTY 

A->B 

220 

TOP_OF 

A->B 

220 

SET  OF  PROFILE:  {3211,2201,330,220} 
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STACK  SEQUENTIAL  BOUNDED  MANAGED  ITERATOR 
ADA  SPECIFICATION 


generic 

type  Item  is  private; 

package  Stack_Sequential_Bounded_KanagecLIterator  is 

type  Stack {The^Size  :  Positive)  is  limited  private; 

procedure  Copy  {From„Th©_Stack  :  in  Stack; 

To_The_Stack  :  in  out  Stack) ; 
procedure  Clear  {The^Stack  :  in  out  Stack) ; 

procedure  Push  (The_Item  :  in  Item; 

On_The_Stack  :  in  out  Stack) ; 
procedure  Pop  (The^Stack  :  in  out  Stack) ; 

—  modified  by  Tuan  Nguyen 
replacing  functions  with  procedures 

procedure  Is_EQ[ual  (Left  :  in  Stack; 

Right  :  in  Stack; 

Result  :  out  Boolean) ; 

procedure  Depth_Of  (The_Stack  ;  in  Stack; 

Result  :  out  Natural ); 

procedure  Is_Empty  (The^Stack  ;  in  Stack; 

Result  :  out  Boolean) ; 

procedure  Top_Of  (The_Stack  ;  in  Stack; 

Result  :  out  Item) ; 

—  end  of  modification 

function  Is_Equal  (Left  :  in  Stack; 


Right  :  in  Stack)  return 

Boolean; 

function  Depth_Of  (The_Stack  :  in  Stack)  return 
Natural; 

function  Is_Eiipty  (The_Stack  :  in  Stack)  return 
Boolean; 

function  Top_Of  (The^Stack  :  in  Stack)  return 
I  tern  ; 

generic 

with  procedure  Process  (The_Item  :  in  I tern; 

Continue  :  out 

Boolean) ; 

procedure  Iterate  (Over_The_Stack  :  in  Stack) ; 

Overflow  :  exception; 

Underflow  :  exception; 

private 

type  Items  is  array (Positive  range  <>)  of  Item; 
type  Stack (The_Size  :  Positive)  is 
record 

The_Top  ;  Natural  :=  0; 

The_Items  :  Items (1  ..  The_Size) ; 
end  record; 

end  Stack_Sequential_Bounded_jManaged_I terator ; 
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STACK  SEQUENTIAL  BOUNDED  MANAGED  ITERATOR 
ADA  IMPLEMENTATION 


—  <C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady 
Booch 

—  All  Rights  Reserved 

—  Serial  Ntimber  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  sxibdivision  (b)  (3) 

(ii) 

—  of  the  rights  in  Technical  Data  and  Cocrputer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 
Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body  Stack_Sequential_BoundedJlanagecaLIterator 
is 

procedure  Copy  (FroauThe^Stack  :  in  Stack; 

To_The_Stack  :  in  out  Stack)  is 

begin 

if  Froit\_The_Stack.The_Top  > 
To_The_Stack.The_Size  then 
raise  Overflow; 

else 

To_The_Stack .  The_I terns  (1  . . 

Fr  oin_The_S  tack .  The_Top )  :  = 

FrottL,The_S tack .  The„I  terns  {1  . . 

Fr on\_The_S tack .  The_Top ) ; 

To_The_Stack . The_Top  : = 

Frortu.The_St  ack .  The_Top  ; 
end  if; 
end  Copy; 

procedure  Clear  (The_Stack  :  in  out  Stack)  is 
begin 

The_Stack . The_Top  : =  0 ; 
end  Clear; 

procedure  Push  (The^Item  :  in  Item; 

On_The_Stack  :  in  out  Stack)  is 

begin 

On_The_S  tack .  The_I  terns  ( On_The_S  t  ack .  The_Top  + 
1)  :=  The_Item; 

On_The_Stack.The_Top  :=  On_The_Stack.The_Top  + 

1; 

exception 

when  Constraint_Error  => 
raise  Overflow; 
end  Push; 

procedure  Pop  (The_Stack  :  in  out  Stack)  is 
begin 

The_Stack .  The_Top  ;=  The_Stack .  The_Top  -  1; 
exception 

when  Constraint_Error  => 
raise  Underflow; 

end  Pop; 

—  modified  by  Tuan  Nguyen 

—  replacing  procedures  with  frmctions 

procedure  Is_Equal  (Left  :  in  Stack; 

Right  ;  in  Stack; 

Result  :  out  Boolean)  is 

begin 

Result  :=  ls_Equal (Left, Right) ; 
end  ls_Equal; 

procedure  Depth_Of  (The_Stack  :  in  Stack; 


Result  :  out  Natural)  is 

begin 

Result  ;=  Depth_Of  (The_Stack)  ; 
end  DepthL.Of; 

procedure  Is_Eo5>ty  (The_Stack  :  in  Stack; 

Result  :  out  Boolean)  is 

begin 

Result  Is_Empty (The_Stack) ; 
end  Is_Errpty; 

procedure  Top_Of  (The^Stack  ;  in  Stack; 

Result  ;  out  Item)  is 

begin 

Resul t  ; =  Top_Of { The_S tack ) ; 
end  Top_Of; 

—  end  of  modification 

function  Is^Equal  (Left  :  in  Stack; 

Right  :  in  Stack)  return  Boolean 
is 

begin 

if  Left.The_Top  /=  Right .TheJTop  then 
return  False; 

else 

for  Index  in  1  . .  Left.The_Top  loop 
if  Left.The_I terns (Index)  /= 

Right  -  The_I  terns  ( Index )  then 

return  False; 
end  if; 
end  loop; 
return  True; 
end  if ; 
end  Is_Equal; 

function  Depth_Of  (The_Stack  ;  in  Stack)  return 
Natural  is 
begin 

return  The_Stack.The„Top; 
end  Depth_Of; 

function  Is_Empty  (The_Stack  ;  in  Stack)  return 
Boolean  is 
begin 

return  (The_Stack.The_Top  =0); 
end  Is_Errpty; 

function  Top_Of  (The^Stack  ;  in  Stack)  return  Item 
is 

begin 

return  The_Stack.The_Items(The_Stack.The_Top)  ; 
exception 

when  Cons t rain t__Err or  => 
raise  Underflow; 
end  Top_Of; 

procedure  Iterate  (Over_The_Stack  :  in  Stack)  is 
Continue  :  Boolean; 
begin 

for  The_Iterator  in  reverse  1  . , 
Over_The_Stack.The_Top  loop 

Process {Over_The_Stack.The_I terns (The^Iterator ) , 
Continue) ; 

exit  when  not  Continue; 
end  loop; 
end  Iterate; 

end  Stack_Seguential_BoundedL>IanagecLIterator ; 


STACK  SEQUENTIAL  BOUNDED  MANAGED  ITERATOR 


PSDL 


TYPE  S  t  ack_Sequent  ial_Bounde<U4anaged^I  t  er  a  tor 
SPECIFICATION 
GENERIC 

Item  :  PRXVATEJTYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

FroitL.The_Stack  :  Stack, 

To_The_Stack  :  Stack 
OUTPUT 

To_The_Stack  :  Stack 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Stack  :  Stack 
OUTPUT 

The_Stack  :  Stack 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Push 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

On_The_Stack  :  Stack 
OUTPUT 

On_The_Stack  :  Stack 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Pop 
SPECIFICATION 
INPUT 

The_Stack  :  Stack 
OUTPUT 

The_Stack  :  Stack 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Is_Equal 
SPECIFICATION 
INPUT 

Left  :  Stack, 

Right  :  Stack 
OUTPUT 


Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Depth^Of 

SPECIFICATION 

INPUT 

The_Stack  :  Stack 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Is_Empty 

SPECIFICATION 

INPUT 

The_Stack  :  Stack 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Top_Of 

SPECIFICATION 

INPUT 

The_Stack  :  Stack 
OUTPUT 

Result  :  Item 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Iterate 

SPECIFICATION 

GENERIC 

Process  :  PROCEDURE fThe_I tern  :  in[t 

Continue  :  out[t  :  Boolean]] 

INPUT 

Over_The_Stack  :  Stack 
EXCEPTIONS 

Overflow,  Underflow 

END 

END 

IMPLEMENTATION  ADA 

S  t  ack_Sequent  ial_Bounded_Jlanaged_I  tera  tor 

END 


Item] , 


252 


STACK  SEQUENTIAL  UNBOUNDED  MANAGED  NONITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

package  Stack_Sequential_Unboundeti_ManagedLNoniterator 
is 

type  Stack  is  limited  private; 

procedure  Copy  (FronuThe_Stack  ;  in  Stack; 

To_The_Stack  ;  in  out  Stack) ; 
procedure  Clear  (The_Stack  ;  in  out  Stack) ; 

procedure  Push  (The_Item  :  in  I tern; 

On_The_Stack  ;  in  out  Stack) ; 
procedure  Pop  (The_Stack  :  in  out  Stack) ; 

—  modified  by  Tuan  Nguyen 

—  replacing  functions  with  procedures 

procedure  ls_Equal  (Left  :  in  Stack; 

Right  :  in  Stack; 

Result  :  out  Boolean) ; 

procedure  D€pth_Of  (The_Stack  ;  in  Stack; 

Result  ;  out  Natural) ; 
procedure  Is^Empty  (The_Stack  :  in  Stack; 


Result  ;  out  Boolean) ; 
procedure  Top_Of  (The^Stack  :  in  Stack; 

Result  :  out  Item)  ; 

—  end  of  modification 

ftinction  Is_Egual  {Left  :  in  Stack; 

Right  :  in  Stack)  return 

Boolean; 

function  Depth_Of  (The_Stack  :  in  Stack)  return 
Natural; 

fimction  Is_Enpty  (The_Stack  ;  in  Stack)  return 
Booleein; 

function  Top_Of  (The_Stack  :  in  Stack)  return 
Item; 

Overflow  ;  exception; 

Underflow  :  exception; 

private 

type  Node; 

type  Stack  is  access  Node; 
end  Stack_Seq[uential_Unbounded_Jlanaged_Noniterator ; 
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STACK  SEQUENTIAL  UNBOUNDED  MANAGED  NONITERATOR 
ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989.  1990  Grady 
Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3) 
{ii) 

—  of  the  rights  in  Technical  Data  and  Computer 
Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

with  StorageJlanager_Sequential; 
package  body 

Stack_Sequential_Unbounded_Jlanaged_Noniterator  is 

type  Node  is 
record 

The_Item  :  I tern; 

Next  :  Stack; 

end  record; 

procedure  Free  (TheJNode  :  in  out  Node)  is 
begin 

null; 
end  Free; 

procedure  Set_Next  (The_Node  :  in  out  Node; 

To^Next  :  in  Stack)  is 

begin 

The_Node.Next  :=  ToJIext; 
end  Set_Next; 


begin 

Terrporary_Node  Node_Nanager  .New_Item; 
Tertporary_Node.The_Item  The_Item; 
Temper ary_Node .Next  ;=  On_The_Stack; 
On_The_Stack  :=  Temporary_JJode; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Push; 

procedure  Pop  (The_Stack  :  in  out  Stack)  is 
Teitporary^ode  :  Stack; 
begin 

Temper ary_Node  :=  The_Stack; 

The_Stack  :=  TenporaryJIode-Next; 
Teiiporary_J^ode.Next  ;=  null; 

Node_Manager . Free ( Temporary_Node ) ; 
exception 

when  Cons train t„Err or  => 
raise  Underflow; 

end  Pop; 

modified  by  Tuan  Nguyen 
replacing  functions  with  procedures 

procedure  Is_Equal  (Left  :  in  Stack; 

Right  :  in  Stack; 

Result  ;  out  Boolean) ; 

procedure  Depth_Of  (The_Stack  :  in  Stack; 

Result  :  out  Natural) 

procedure  Is^Eopty  (The_Stack  ;  in  Stack; 

Result  ;  out  Boolean) ; 

procedure  Top_Of  (The_Stack  :  in  Stack; 

Result  ;  out  Item) ; 

end  of  modification 


function  Next_Of  (The_JJode  :  in  Node)  return  Stack 
l>egin 

return  The_Node.Next ; 
end  Next_Of; 


package  Node_Manager  is  new 
S  t  or age_Manage  r_Sequen t i a 1 

Node, 


(Item  => 

Pointer  => 


Stack, 

Free  ->  Free, 

Set_Po inter  =>  SetJMext, 
Pointer_Of  =>  Next_Of ) ; 


procedure  Copy  (From_The_Stack  :  in  Stack; 

To_The_Stack  :  in  out  Stack)  is 
FrortL.Index  :  Stack  :=  FronuThe.Stack; 

To_Index  :  Stack; 
begin 

NodeJManager . Free (To_The_Stack) ; 
if  FrortuThe_Stack  /-  null  then 

To_The_Stack  NodeJlanager.New_Item; 
To_The_Stack.The_Item  :  = 

Froin_Index .  The_I  tern; 

To_Index  :=  To_The_Stack; 

Froirulndex  :=  From_Index.Next; 
while  From_Index  /=  null  loop 

To_Index .  Next  :  =  Node^Manager .  New„I tem; 
To^lndex  :=  To_Index . Next ; 
To_Index.The_Item 
From_Index . The_Item; 

FronL.Index  :=  From_Index.Next; 
end  loop; 
end  if; 
exception 

when  Storage^Error  => 
raise  Overflow ; 
end  Copy; 


procedure  Clear  (The_Stack  ;  in  out  Stack)  is 
begin 

Node_Manager . Free (The_S tack) ; 
end  Clear; 

procedure  Push  (The_Item  :  in  Item; 

On_The_Stack  :  in  out  Stack)  is 
Temporary JNTode  :  Stack; 


function  Is_Equal  (Left  ;  in  Stack; 

Right  :  in  Stack)  return  Boolean 
is 

Left^Index  ;  Stack  :=  Left; 

Right_Index  :  Stack  :=  Right; 
begin 

while  Left_Index  /=  null  loop 
if  Left_Index.The„Item  /= 
Right_Index.The_Item  then 

return  False; 
end  if; 

Left_Index  :=  Left_Index.Next ; 

Right_Index  ;=  Right_Index .  Next ; 
end  loop; 

retum  (Right_Index  =  null); 
exception 

when  Constraint^Error  => 
return  False; 
end  Is_Equal; 

function  Depth^Of  (The_Stack  :  in  Stack)  return 
Natural  is 

Coiint  :  Natural  :=  0; 

Index  :  Stack  :=  The_Stack; 
begin 

while  Index  /=  null  loop 
Coxont  :=  Count  +  1; 

Index  Index. Next; 
end  loop; 
return  Count; 
end  Depth_Of; 

function  Is_Enpty  (The_Stack  :  in  Stack)  return 
Boolean  is 
begin 

return  (The„Stack  =  null); 
end  Is_Empty; 

function  Top_0f  (The_Stack  :  in  Stack)  return  Item 
is 

begin 

return  The_S tack. The_I tern; 
exception 

when  Constraint_Error  => 
raise  Underflow; 
end  Top_0f; 

end  stack_Sequential_UnboundedJManaged_Noniterator ; 
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STACK  SEQUENTIAL  UNBOUNDED  MANAGED  NONITERATOR 

PSDL 


TYPE  Stack_Sequential_Unbounded_jManagecLNoniterator 
SPECIFICATION 

GENERIC 

Item  :  PRIVATE_TYPE 

OPERATOR  Copy 

SPECIFICATION 

INPUT 

Froiru.The_Stack  :  Stack, 

To_The_Stack  :  Stack 
OUTPUT 

To_The_Stack  :  Stack 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Clear 

SPECIFICATION 

INPUT 

The_Stack  :  Stack 
OUTPUT 

The_Stack  :  Stack 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Push 

SPECIFICATION 

INPUT 

The_Item  ;  Item, 

On_The_Stack  :  stack 
OUTPUT 

On_The_Stack  :  Stack 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Pop 

SPECIFICATION 

INPUT 

The_Stack  :  Stack 
OUTPUT 

The_Stack  :  Stack 
EXCEPTIONS 

Overflow,  Underflow 

END 


OPERATOR  IS^Egual 

SPECIFICATION 

INPUT 

Left  :  Stack, 

Right  :  Stack 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Depth_Of 

SPECIFICATION 

INPUT 

The_Stack  :  Stack 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Is_Enpty 

SPECIFICATION 

INPUT 

The_Stack  :  Stack 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Top_Of 

SPECIFICATION 

INPUT 

The_Stack  :  Stack 
OUTPUT 

Result  :  Item 
EXCEPTIONS 

Overflow,  Underflow 

END 

END 

IMPLEMENTATION  ADA 

S  tack_Sequent  ial_UnboundecLManaged_Noni  ter  at  or 
END 
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STACK  SEQUENTIAL  UNBOUNDED  MANAGED  ITERATOR 
ADA  SPECIFICATION 


generic 

type  Item  is  private; 

package  stack_Sequential_Unboundedl_Managed_Iterator  is 


type  Stack  is  limited  private; 


procedure  Copy  (Froitv_'rhe_Stack  :  in  Stack; 

To_The_Stack 

:  in  out  Stack) 

procedure  Clear  (The_Stack 

:  in  out  Stack) 

procedure  Push  {The_Item 

:  in  Item; 

On_The_Stack 

:  in  out  Stack) 

procedure  Pop  (The_Stack 

:  in  out  Stack) 

modified  by  Tuan  Nguyen 

replacing  functions  with  procedures 

procedure  Is_Equal  (Left 

in  Stack; 

Right 

in  Stack; 

Result 

out  Boolean) ; 

procedure  Depth__Of  (The^Stack 

:  in  Stack; 

Result 

:  out  Natural) ; 

procedure  Is^Enpty  (The_Stack  ; 

in  Stack; 

Result  : 

out  Boolean) ; 

procedure  Top^Of  (The_Stack  : 

in  Stack; 

Result  : 

out  Item) ; 

end  of  modification 


function  Is_Equal 
Boolean; 

function  Depth^Of 
Natural ; 

function  Is_Einpty 
Boolean; 

function  Top_Of 
I  tern; 


(Left 

Right 

(The_Stack 

(The_Stack 

(The_Stack 


in 

in 

Stack; 

Stack) 

return 

in 

Stack) 

return 

in 

Stack) 

return 

in 

Stack) 

return 

generic 

with  procedure  Process  (The_Item  :  in  I tern; 

Continue  :  out 

Boolean) ; 

procedure  Iterate  {Over_The_Stack  :  in  Stack) ; 


Overflow  :  exception; 
Underflow  :  exception; 


private 

type  Node; 

type  Stack  is  access  Node; 
end  Stack_Sequential_Unbotmded_Managed_It€rator ; 
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STACK  SEQUENTIAL  UNBOUNDED  MANAGED  ITERATOR 
ADA  IMPLEMENTATION 


--  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady 
Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

•Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  sxibject  to 

--  restrictions  as  set  forth  in  subdivision  (b)  (3) 
(ii) 

—  of  the  rights  in  Technical  Data  and  Computer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

with  Storage_Manager_Sequential ; 
package  body 

Stack_Sequential_UnboundecL>IanagecLIterator  is 


exception 

when  Storage_Error  => 
raise  Overflow; 
end  Push; 

procedure  Pop  (The_Stack  :  in  out  Stack)  is 
TemporaryJHode  :  Stack; 
begin 

Teitporary_Node  :=  The_Stack; 

The_Stack  :=  Teiiporary_^ode.Next; 
Tercporary^Node . Next  ;  =  null ; 
Node_Manager. Free (Tempor ary JNode)  ; 
exception 

when  Constraint_Error  => 
raise  Underflow; 

end  Pop; 

modified  by  Tuan  Nguyen 
replacing  ftmctions  with  procedures 


type  Node  is 
record 

The_Item  ;  Item; 

Next  ;  Stack; 

end  record; 

procedure  Free  (The_Node  :  in  out  Node)  is 
begin 

null; 
end  Free; 

procedure  SetJtJext  {TheJNode  :  in  out  Node; 

To_Next  :  in  Stack)  is 

begin 

The^Node.Next  :=  To_Next; 
end  SetJNext; 

function  Next_0f  (The_JJode  :  in  Node)  return  Stack 
begin 

return  The_Node.Next; 
end  Next_Of; 


package  Nodejlanager  is  new 
S  t  or  age_Manager_Sequen  t  ial 

Node, 


(Item  => 

Pointer  => 


Stack, 

Free  =>  Free, 

Set_Pointer  =>  Set_Next, 
Po interact  =>  Next_0f ) ; 


procedure  Copy  (From_The_Stack  :  in  Stack; 

To_The_Stack  :  in  out  Stack)  is 
From_Index  :  Stack  :=  From_The_Stack; 

To_Index  ;  Stack; 
begin 

Node_Manager .  Free  { To_The_St ack )  ; 
if  From_The_Stack  /=  null  then 

To_The_Stack  ;=  Node_Manager  .New_Item; 
To_The_Stack.The_Item  ;= 

From_lndex .  The_„I  tem; 

To_Index  :=  To_The_Stack; 

From_Index  ;=  From_Index.Next ; 
while  Fronulndex  /*  null  loop 

To_Index,Next  :=  Node^anager .New^Item; 
To_Index  :=  To_Index.Next; 

To_Index . The_Item  ;= 

From_lndex . The^Item; 

Fronuindex  :=  From_Index.Next ; 
end  loop; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Copy; 


procedure  Clear  (The_Stack  :  in  out  Stack)  is 
begin 

Node_Manager .  Free  { The_S  tack ) 
end  Clear; 

procedure  Push  ('Ilie_Item  :  in  I  tern; 

On_The_Stack  ;  in  out  Stack)  is 
Tempor aryJMode  :  Stack; 
begin 

Temporary_Node  :=  Node_Managei'*New^Item; 
Terrporary_Node.The_Item  :=  The_Item; 
Temporary_Node.Next  :=  On_The_Stack; 
On_The_Stack  :=  Tenporary JNode ; 


procedure  Is_Equal  (Left  :  in  Stack; 

Right  :  in  Stack; 

Result  :  out  Boolean) ; 

procedure  Depth_Of  (The_Stack  :  in  Stack; 

Result  :  out  Natural); 
procedure  Is^Empty  {The_Stack  :  in  Stack; 

Result  :  out  Boolecin)  ; 

procedure  Top_0f  (The^Stack  :  in  Stack; 

Result  :  out  Item) ; 

—  end  of  modification 

function  Is_Equal  (Left  :  in  Stack; 

Right  :  in  Stack)  return  Boolean 
is 

Left_Index  ;  Stack  :=  Left; 

Right_Index  :  Stack  :=  Right; 
begin 

while  Left_Index  /=  null  loop 
if  Left_Index.The_Item  /= 

Right_Index .  The_Item  then 

return  False; 
end  if; 

Left_Index  Left_Index.Next; 

Right_Index  :=  Right_Index.Next ; 
end  loop; 

return  (Right_Index  =  null) ; 
exception 

when  Constraint^Error  => 
return  False; 
end  ls_Equal; 

function  Depth_0f  (The_Stack  :  in  Stack)  return 
Natural  is 

Count  :  Natural  :=  0; 

Index  :  Stack  :=  The_Stack; 
begin 

while  Index  /=  null  loop 
Coxint  ;=  Count  +  1; 

Index  :=  Index  .Next; 
end  loop; 
return  Count; 
end  Depth_Of; 

fxmction  Is_Empty  (The_Stack  :  in  Stack)  return 
Boolean  is 
begin 

return  (The_Stack  =  null) ; 
end  Is^Enpty; 

function  Top_Of  (The_Stack  ;  in  Stack)  return  Item 
is 

begin 

return  The_Stack.The_Item; 
exception 

when  Constraint_Error  => 
raise  Underflow; 
end  Top_Of; 

procedxrre  Iterate  (Over_The„Stack  :  in  Stack)  is 
The_Iterator  :  Stack  :=  Over_The_Stack; 

Continue  :  Boolecin; 

begin 

while  not  (The_Iterator  »  null)  loop 

Process (The_Iterator .The_Item,  Continue) ; 
exit  when  not  Continue; 

The_Iterator  :=  The^Iterator .Next ; 
end  loop; 
end  Iterate; 

end  S  tack_Secauential_Unbounded_Manageci_I  terator  ; 
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STACK  SEQUENTIAL  UNBOUNDED  MANAGED  ITERATOR 

PSDL 


TYPE  Stack_Seguential_Uribounded_Managec5LIterator 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE^TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

FroirL_The_Stack  ;  Stack, 

To_The_Stack  ;  Stack 
OUTPUT 

To_The_Stack  :  Stack 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Stack  :  Stack 
OUTPUT 

The_Stack  :  Stack 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Push 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

On_The_Stack  :  Stack 
OUTPUT 

On_The_Stack  :  Stack 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Pop 
SPECIFICATION 
INPUT 

The_Stack  :  Stack 
OUTPUT 

The_Stack  :  Stack 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Is_Equal 
SPECIFICATION 
INPUT 

Left  :  Stack, 

Right  ;  Stack 
OUTPUT 


Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Depth.Of 

SPECIFICATION 

INPUT 

The_Stack  ;  Stack 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  IS^Eopty 

SPECIFICATION 

INPUT 

The_Stack  :  Stack 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Top_Of 

SPECIFICATION 

INPUT 

The^Stack  :  Stack 
OUTPUT 

Result  :  Item 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Iterate 

SPECIFICATION 

GENERIC 

Process  :  PROCEDURE [The_I tern  :  in[t  : 

Continue  :  out[t  :  Boolean]] 

INPUT 

Over_The_Stack  :  Stack 
EXCEPTIONS 

Overflow,  Underflow 

END 

END 

IMPLEMENTATION  ADA 

Stack_Sequential_Unboiinde<OIanaged_Iterator 

END 


Item] , 
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STACK  SEQUENTIAL  UNBOUNDED  UNMANAGED  NONITERATOR 

ADA  SPECIFICATION 


generic 

type  Item  is  private; 
package 

Stack_Seguential_Unboxmded^Uninanaged_Noniterator  is 
type  Stack  is  limited  private; 

procedure  Copy  {Fronu.The_Stack  :  in  Stack; 

To_The_Stack  :  in  out  Stack) ; 
procedure  Clear  (The_Stack  :  in  out  Stack) ; 

procedure  Push  (The^Item  ;  in  Item; 

On_The_Stack  :  in  out  Stack) ; 
procedure  Pop  (The_Stack  :  in  out  Stack) ; 

—  modified  by  Tuan  Nguyen 

—  replacing  functions  with  procedures 

procedure  Is_Eciual  (Left  :  in  Stack; 

Right  :  in  Stack; 

Result  :  out  Boolean) ; 

procedure  Depth^Of  (The_Stack  ;  in  Stack; 

Result  :  out  Natural) ; 

procedure  Is_Empty  (The_Stack  :  in  Stack; 


Result  :  out  Boolean) ; 
procedure  Top_Of  (The_Stack  :  in  Stack; 

Result  :  out  Item) ; 

—  end  of  modification 

function  Is^Equal  (Left  :  in  Stack; 

Right  :  in  Stack)  return 

Boolean ; 

function  Depth_Of  (The_Stack  :  in  Stack)  return 
Natural ; 

function  Is_En5)ty  (The_Stack  ;  in  Stack)  return 
Boolean; 

f\inction  Top_Of  (The^Stack  ;  in  Stack)  return 
Item; 

Overflow  :  exception; 

Underflow  :  exception; 

private 

type  Node; 

type  Stack  is  access  Node; 

end  S  t  ack_Sequential_Unbounded_Uninanaged_Noni  terator ; 
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STACK  SEQUENTIAL  UNBOUNDED  UNMANAGED  NONITERATOR 

ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady 
Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  srabdivision  (b)  (3) 

(ii) 

—  of  the  rights  in  Technical  Data  eind  Computer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer; 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body 

Stack_Sequential_Unbounded_UnitianagedLJMoniterator  is 

type  Node  is 
record 

The_Item  :  Item; 

Next  :  Stack; 

end  record; 


procedure  Copy  (From_The_Stack  :  in  Stack; 

To_The_Stack  :  in  out  Stack)  is 
Fronulndex  :  Stack  FrorruThe_Stack; 

To^Index  :  Stack; 
begin 

if  From_The_Stack  =  null  then 
To_The_Stack  :=  null; 

else 

To_The_Stack  :=  new  Node* {The_Item  => 
From_Index .  The_Itein, 

Next  => 

null) ; 

To_Index  :=  To_The_Stack; 

From_Index  From_Index-Next  ; 
while  Fronuindex  i-  null  loop 

To_Index.Next  :=  new  Node'  (The_Item  => 
From_Index .  The_Item, 

Next  => 

null) ; 

To_Index  :=  To_Index.Next ; 

FronL-Index  ;=  From_Index.Next ; 
end  loop; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Copy; 

procedure  Clear  (The_Stack  ;  in  out  Stack)  is 
begin 

The_Stack  :=  null; 
end  Clear; 


procedure  Push  (The_Item  :  in  Item; 

On_The_Stack  :  in  out  Stack)  is 

begin 

On_The_Stack  ;=  new  Node'  (The_Item  =>  The_Item, 


Next  => 


On_The_Stack)  ; 
exception 

when  Storage_Error  => 
raise  Overflow; 


end  Push; 


procedure  Pop  (The_Stack  :  in  out  Stack)  is 


begin 

The_Stack  :=  The_S tack. Next; 
exception 

when  Constraint_Error  => 
raise  Underflow; 

end  Pop; 

—  modified  Iv  Tuan  Nguyen 

—  replacing  fxinctions  with  procedures 

procedure  Is_Equal  (Left  :  in  Stack; 

Right  ;  in  Stack; 

Result  ;  out  Boolean); 

procedure  Depth_Of  (The^Stack  :  in  Stack; 

Result  :  out  Natural) ; 

procedure  Is_Eicpty  (The_Stack  :  in  Stack; 

Result  :  out  Boolean) ; 

procedure  Top_0f  {The_Stack  :  in  Stack; 

Result  :  out  Item)  ; 

—  end  of  modification 


function  Is_Equal  (Left  :  in  Stack; 

Right  :  in  Stack)  return  Boolean 
is 

Left_Index  :  Stack  Left; 

Right_Index  :  Stack  Right; 

begin 

while  Left_Index  /=  null  loop 
if  Left_Index.The_Item  /= 

Righ t_Index - The_I tern  then 

return  False; 
end  if; 

Left_Index  :=  Left_Index.Next ; 

Right^Index  :=  Righ t_Index. Next ; 
end  loop; 

return  (Right_Index  =  null); 
exception 

when  Constraint_Error  => 
return  False; 
end  Is_Equal; 

ftinction  Depth_Of  (The_Stack  ;  in  Stack)  return 
Natural  is 

Count  :  Natural  :=  0; 

Index  :  Stack  :=  The_Stack; 
begin 

while  Index  /=  null  loop 
Count  :=  Count  +  1; 

Index  :=  Index. Next; 
end  loop; 
return  Co\int; 
end  Depth_0f; 

function  Is_Eirpty  (The_Stack  ;  in  Stack)  return 
Boolean  is 
begin 

return  ('Ihe_Stack  =  null)  ; 
end  Is_En5>ty; 

function  Top_0f  (The_Stack  :  in  Stack)  return  Item 
is 

begin 

return  'rhe_Stack.The_Item; 
exception 

when  Constraint_Error  => 
raise  Underflow; 
end  Top_Of; 

end  Stack_Se(3uential_Unboimded_Unmanaged JJoni  terator ; 
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STACK  SEQUENTIAL  UNBOUNDED  UNMANAGED  NONITERATOR 

PSDL 


TYPE  Stack_Sequential_Unbounded_UnitianagedLNoniterator 
SPECIFICATION 

GENERIC 

Item  :  PRIVATE.TYPE 

OPERATOR  Copy 

SPECIFICATION 

INPUT 

FronL_The_Stack  :  Stack, 

To__The_Stack  :  Stack 
OUTPUT 

To_The_Stack  ;  Stack 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Clear 

SPECIFICATION 

INPUT 

The_Stack  :  Stack 
OUTPUT 

The_Stack  :  Stack 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Push 

SPECIFICATION 

INPUT 

The_Item  :  Item, 

On_The_Stack  :  Stack 
OUTPUT 

On_The_Stack  :  Stack 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Pop 

SPECIFICATION 

INPUT 

The_Stack  :  Stack 
OUTPUT 

The_Stack  :  Stack 
EXCEPTIONS 

Overflow,  Underflow 

END 


OPERATOR  Is_Equal 

SPECIFICATION 

INPUT 

Left  ;  Stack, 

Right  :  Stack 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Depth^Of 

SPECIFICATION 

INPUT 

The_Stack  :  Stack 
OUTPUT 

Result  ;  Natural 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Is^Empty 

SPECIFICATION 

INPUT 

The_Stack  :  Stack 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Top_Of 

SPECIFICATION 

INPUT 

The_Stack  :  Stack 
OUTPUT 

Result  :  Item 
EXCEPTIONS 

Overflow,  Underflow 

END 

END 

IMPLEMENTATION  ADA 

Stack_Sequential_UnbotmdedJJnmanaged_Noniterator 

END 
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STACK  SEQUENTIAL  UNBOUNDED  UNMANAGED  ITERATOR 
ADA  SPECIFICATION 


generic 

type  Item  is  private; 

package  Stack_SequentialJcrnboxindedLUninanaged_Iterator 
is 


type  Stack  is  limited  private; 


procedure  Copy  (From_The_^Stack  :  in  Stack; 

To_The_Stack 

:  in  out  Stack) ; 

procedure  Clear  (The_Stack 

:  in  out  Stack) ; 

procedure  Push  {The_Item 

:  in  I  tern; 

On_The_Stack 

;  in  out  Stack) ; 

procedure  Pop  {The_Stack 

:  in  out  Stack) ; 

modified  by  Tuan  Nguy^ 

replacing  functions  with  procedures 

procedure  ls_E<3ual  (Left 

:  in  Stack; 

Right 

:  in  Stack; 

Result 

:  out  Boolean) ; 

procedure  Depth_Of  (The_Stack 

:  in  Stack; 

Result 

;  out  Natural )  ; 

procedure  Is_Enpty  (The_Stack 

:  in  Stack; 

Result 

;  out  Boolean) ; 

procedure  Top_Of  (The_Stack  : 

in  Stack; 

Result  : 

out  Item) ; 

end  of  modification 


function  Is^Egual 
Boolean; 

fimction  Depth^Of 
Natural ; 

function  Is_Enpty 
Boolean; 

function  Top_Of 
Item; 


(Left 

Right 

{The_Stack 

( The_Stack 

{The_Stack 


in  Stack; 
in  Stack)  return 

in  Stack)  return 

in  Stack)  return 

in  Stack)  return 


generic 

with  procedure  Process  (The_Item  :  in  Item; 

Continue  ;  out 

Boolean) ; 

procedure  Iterate  {Over_The_Stack  :  in  Stack) ; 


Overflow  :  exception; 
Underflow  :  exception; 


private 

type  Node; 

type  Stack  is  access  Node; 

end  Stack_Sequential_Unbounded_Uninanage<i_Iterator ; 
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STACK  SEQUENTIAL  UNBOUNDED  UNMANAGED  ITERATOR 
ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady 
Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

“Restricted  Rights  Legend* 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  siibdivision  (b)  (3) 

<ii) 

—  of  the  rights  in  Technical  Data  and  Computer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer; 
--  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 


modified  by  Tuan  Nguyen 
replacing  functions  with  procedures 

procedure  Is_Equal  (Left  :  in  Stack; 

Right  ;  in  Stack; 

Result  ;  out  Boolean) ; 

procedure  Depth_Of  {The_Stack  :  in  Stack; 

Result  :  out  Natural) ; 
procedure  Is_Eitpty  {The_Stack  :  in  Stack; 

Result  :  out  Boolean) ; 

procedure  Top_Of  (The^Stack  ;  in  Stack; 

Result  :  out  Item) ; 

end  of  modification 


package  body 

S tacK-Sequential_Unbounded_Unmanaged_I terator  is 

type  Node  is 
record 

The_Item  :  Item; 

Next  :  Stack; 
end  record; 

procedure  Copy  (From_The_Stack  ;  in  Stack; 

To_The_Stack  :  in  out  Stack)  is 
Fronulndex  :  Stack  :=  Front.The_Stack; 

To_Index  :  Stack ; 
begin 

if  Froii\_The_Stack  =  null  then 
To„The_Stack  :=  null; 

else 

To^The_Stack  ;=  new  Node'  (The_Item  => 
From_Index . The_Item, 

Next  => 

null) ; 

To_Index  :=  To_The_„Stack; 

Fronuindex  ;=  From^Index.Next; 
while  Fron\_Index  /=  null  loop 

To_Index . Next  :=  new  Node'  (The_Item  => 
Fromulndex .  The_I  tern. 

Next  => 

null) ; 

To^Index  : =  To_Index . Next ; 

From_Index  :=  From_Index,Next; 
end  loop; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Copy; 

procedure  Clear  (The_Stack  :  in  out  Stack)  is 
begin 

The_Stack  :=  null; 
end  Clear; 


procedure  Push  {The_Item  :  in  Item; 

On_The_Stack  :  in  out  Stack)  is 

begin 

On_The_Stack  ;=  new  Node'  (The_Item  =>  The_Item, 
Next  => 


On_The_Stack) ; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Push; 


procedure  Pop  (The_Stack  :  in  out  Stack)  is 
begin 

The_Stack  :=  The_S tack. Next ; 
exception 

when  Constraint_Error  => 
raise  Underflow; 

end  Pop; 


function  Is_Equal  (Left  :  in  Stack; 

Right  :  in  Stack)  return  Boolean 
is 

Left^Index  ;  Stack  ;=  Left; 

Right_Index  :  Stack  :=  Right; 
begin 

while  Left_Index  /=  null  loop 
if  Left_Index.The_Item  /= 

Righ t_Index . The_I tern  then 

return  False; 
end  if; 

Left^Index  :=  Lef t_Index.Next; 

Right^Index  Righ t_Index. Next; 

end  loop; 

return  (Right_Index  =  null); 
exception 

when  Constraint_Error  -> 
return  False; 
end  Is_Equal; 

fxinction  Depth_Of  (The_Stack  :  in  Stack)  return 
Natural  is 

Count  ;  Natural  :=  0; 

Index  :  Stack  :=  The_Stack; 
begin 

while  Index  /-  null  loop 
Count  :=  Covint  +  1; 

Index  ;=  Index. Next; 
end  loop; 
return  Count; 
end  Depth^Of; 

function  Is^Empty  (The_Stack  :  in  Stack)  return 
Boolean  is 
begin 

return  (The_Stack  =  null); 
end  Is_Empty; 

function  Top_Of  (The^Stack  :  in  Stack)  return  Item 
is 

begin 

return  The_Stack.The_Item; 
exception 

when  Constraint_Error  => 
raise  Underflow; 
end  Top_Of  ; 

procedure  Iterate  (Over_The_Stack  :  in  Stack)  is 
The_I terator  :  Stack  :=  Over_The_Stack; 

Continue  :  Boolean; 

begin 

while  not  (The_Iterator  =  null)  loop 

Process {The_I ter a tor .The_I tern.  Continue) ; 
exit  when  not  Continue; 

The_Iterator  :=  The_I terator .Next ; 
end  loop; 
end  Iterate; 

end  S tack_Sequential_Unbounded_Unmanaged_I terator ; 
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STACK  SEQUENTIAL  UNBOUNDED  UNMANAGED  ITERATOR 

PSDL 


TYPE  Stack_Sequential_Unbo\indecLUninanaged_Iterator 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPXJT 

FrottuThe_Stack  ;  Stack, 

To_The_Stack  :  Stack 
OUTPUT 

To_The_Stack  :  Stack 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Stack  :  Stack 
OUTPUT 

T^e^Stack  :  Stack 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Push 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

On_The_Stack  :  Stack 
OUTPUT 

On_The_Stack  :  Stack 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Pop 
SPECIFICATION 
INPUT 

The_Stack  :  Stack 
OUTPUT 

The_Stack  ;  Stack 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Is_Equal 
SPECIFICATION 
INPUT 

Left  :  Stack, 

Right  :  Stack 


OUTPUT 

Result  ;  Boolean 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Depth_Of 

SPECIFICATION 

INPUT 

The_Stack  :  Stack 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Is_Einpty 

SPECIFICATION 

INPUT 

The_Stack  :  Stack 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Top_Of 

SPECIFICATION 

INPUT 

The_Stack  :  Stack 
OUTPUT 

Result  :  Item 
EXCEPTIONS 

Overflow,  Underflow 

END 

OPERATOR  Iterate 

SPECIFICATION 

GENERIC 

Process  :  PROCEDXJRE[The_Item  :  in  It  :  Item] 
Continue  :  out(t  :  Boolean]] 

INPUT 

Over_The_Stack  :  Stack 
EXCEPTIONS 

Overflow,  Underflow 

END 

END 

IMPLEMENTATION  ADA 

S t ack_Sequen t ial_Unbounded_Unmanaged_I ter a t or 
END 


264 


STORAGE  MANAGER  SEQUENTIAL 


ADA  SPECIFICATION 


generic 

type  Item  is  limited  private; 
type  Pointer  is  access  Item; 

with  procedure  Free  (The_Item  :  in  out 

Item)  ; 

with  procedure  Set^Po inter  (The^Item  :  in  out 
I  tern; 

The_Pointer  :  in 

Pointer) ; 

with  function  Pointer^Of  (The^ltem  :  in  Item) 
return  Pointer; 

package  StorageJManager_Sequential  is 


procedure  Free  (The_Po inter  :  in  out  Pointer) 

—  modified  by  Tuan  Nguyen 

—  replace  function  with  procedure 

procedure  New_Item  (Result  :  Pointer) ; 

—  end  of  modification 

function  New_Item  return  Pointer; 
end  Storage_Manager_Sequential; 
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STORAGE  MANAGER  SEQUENTIAL 
ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady 
Booch 

—  All  Rights  Reserved 

—  Serial  Nuinber  0100219 

“Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  sxibject  to 

—  restrictions  as  set  forth  in  sxabdivision  (b)  (3) 

(ii) 

—  of  the  rights  in  Technical  Data  and  Coitputer 

—  Software  Clause  of  FAR  52.227-7013-  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body  Storage_Mcinager_Sequential  is 
Free_List  :  Pointer  ;=  null; 

procedure  Free  {The_Pointer  :  in  out  Pointer)  is 
Tenporary_Po inter  :  Pointer; 
begin 

while  The_Pointer  /=  null  loop 

Terrporary_Pointer  :  =  The_Pointer  ; 

The_Po inter  : =  Pointer_Of ( The_Po inter . al 1 ) ; 
Free  ( Ternporary_Pointer .  all )  ; 

Set_Po  inter  (Tenporary_Pointer ,  all, 
The_Pointer  =>  Free_List) ; 

Free_List  :=  Ten?>orary_Po  inter ; 


end  loop; 
end  Free; 

—  modified  by  Tuan  N^yen 

—  replace  function  with  procedure 

procedure  New^Iteiti  (Result  :  Pointer)  is 
begin 

Result  New_Item; 
end  New_Item; 

—  end  of  modification 

function  New_ltem  return  Pointer  is 
Tenporary^Pointer  :  Pointer; 
begin 

if  Free_List  =  null  then 
return  new  Item; 

else 

Teraporary_Po inter  :=  Free_List; 
Free_List  : = 

Pointer_Of  (TeiT^>orary_Po inter  .all)  ; 

Set_Pointer  (Tert5)orary_Po  inter .  all , 
The_Pointer  =>  null) ; 

return  Ten?)orary_Pointer  ; 
end  if; 
end  New_Item; 

end  Storage_Manager_Seguential; 
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STORAGE  MANAGER  SEQUENTIAL 


PSDL 


OPERATOR  Free 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE.TYPE, 

Pointer  :  ACCESS.TYPE, 

Free  :  PROCEDURE [The_I tern  :  in_out[t  :  Item] ] , 
Set.Pointer  ;  PROCEDURE [The_I tern  :  in^outlt  : 
Item],  The^Pointer  :  in[t  :  Pointer]], 

Pointer_Of  :  FUNCTION [The_I tern  ;  Item,  RETURN  : 
Pointer] 


INPUT 

The_Pointer  :  Pointer 
OUTPUT 

The_Pointer  :  Pointer 

END 


IMPLEMENTATION  ADA  Free 
END 
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STRING  SEQUENTIAL  UNBOUNDED  CONTROLLED  ITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

type  Siibstring  is  array  (Positive  range  <>)  of  Item; 
with  function  "<"  (Left  :  in  Item; 

Right  :  in  Item)  return  Boolean; 
package  String_Sequential_UnboundecLControlled_lterator  is 


type  String  is  limited  private; 


procedure  Copy 

procedure  Copy 

procedure  Clear 
procedure  Prepend 

procedure  Prepend 

procedure  Append 

procedure  Append 

procedure  Insert 

procedure  Insert 

procedure  Delete 

procedure  Replace 

procedure  Replace 

procedure  Set_Item 


{ FroituThe_String 
To_The_S  tr ing 
{ Fr  oiiL.The_Subs  t  r  ing 
To_The„S  tr ing 
(The_String 
{The_String 
To_The_S  tring 
{ The_Subs  tring 
To_The_S  tring 
(The_S tring 
To_The_String 
{The_Subs tring 
To  jrhe_S  tring 
(The_S tring 
In_The_S tring 
At_The_Position 
(The^Subs tring 
In_The_String 
At_The_Position 
{ In_The_S tring 
FronL.The_Pos  i  t  ion 
To_The_Pos i t ion 
(In_The_String 
At_The_Pos i t ion 
Wi th_The_S  tring 
( In jrhe_S tring 
At_The_Position 
Wi th_The_Subs  tring 
{ In_The_S tring 
At_The_Pos i t ion 
With_The_Item 


in 

String; 

in  out 

String) ; 

in 

Substring; 

in  out 

String) ; 

in  out 

String) ; 

in 

String; 

in  out 

String) ; 

in 

Siibstring; 

in  out 

String) ; 

in 

String; 

in  out 

String) ; 

in 

Substring; 

in  out 

String) ; 

in 

String; 

in  out 

String; 

in 

Positive) ; 

in 

Substring; 

in  out 

String; 

in 

Positive) ; 

in  out 

String; 

in 

Positive; 

in 

Positive) ; 

in  out 

String; 

in 

Positive; 

in 

String) ; 

in  out 

String; 

in 

Positive; 

in 

Substring) 

in  out 

String; 

in 

Positive; 

in 

Item) ; 

—  modified  by  Vincent  Hong  and  Tuan  Nguyen 

—  date:  9  April  1995 

adding  procedures  to  replace  fvmctions 


procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 


Is_Equal 

(Left 

in  String; 

Right 

in  String; 

Result 

out  Boolean) ; 

Is_Equal 

(Left 

in  Substring; 

Right 

in  String; 

Result 

out  Boolean) ; 

Is_Equal 

(Left 

in  String; 

Right 

in  Substring; 

Result 

out  Boolean) ; 

Is_Less_Than 

(Left 

in  String; 

Right 

in  String; 

Result 

out  Boolean) ; 

Is_Less_Thcui. 

(Left 

in  Substring; 

Right 

in  String; 

Result 

out  Boolean) ; 

Is_Less_Than 

(Left 

in  String; 

Right 

in  Substring; 

Result 

out  Boolean) ; 

Is_Greater_Than 

(Left 

in  String; 

Right 

in  String; 

Result 

out  Boolean) ; 

I s_Gr ea t er_Than 

(Left 

in  Subs tring ; 

Right 

in  String ; 

Result 

out  Boolean) ; 

IsjGreater_Than 

(Left 

in  String; 

Right 

in  Substring; 

Result 

out  Boolean) ; 

procedure  Length_Of 

(The_S tring 

;  in  String ; 

Result 

:  out  Natural)  ; 

procedure  Is_Null 

(The_S tring 

:  in  String; 

Result 

:  out  Booleein)  ; 

procedure  Item_Of 

(The^String 

;  in  String ; 

At_The_Pos it ion 

:  in  Positive; 

Result 

:  out  Item)  ; 

procedure  Substring_Of 

(The_S tring 

:  in  String ; 

Result 

:  out  Substring) ; 

procedure  Substring_Of 

(The_S tring 

:  in  String ; 

From_The_Posi tion 

:  in  Positive; 

To_The_Pos i tion 

:  in  Positive; 

Result 

:  out  Substring); 

—  end  of  modification 

function  Is^Equal 

(Left  ; 

in  String; 

Right  : 

in  String)  return 

Boolean; 

function  Is_Equal 

(Left  : 

in  Substring; 

Right  : 

in  String)  return 

Boolean; 

function  Is_Equal 

(Left  : 

in  String; 

Right  : 

in  Substring)  return 

Boolean; 

function  Is_Less_Than 

(Left  : 

in  String; 

Right  : 

in  String)  return 

Boolean; 

function  Is_Less_Than 

(Left  : 

in  Substring; 

Right  : 

in  String)  return 

Boolean; 

function  Is_Less_Than 

(Left  : 

in  String; 

Right  : 

in  Sxdsstring)  return 

Boolean; 

function  Is_Greater_Thcm 

(Left  : 

in  String ; 

Right  : 

in  String)  return 

Boolean; 

function  Is_Greater„Than 

(Left  : 

in  Substring; 

Right  : 

in  String)  return 

Boolean; 

function  Is_Greater_Than 

(Left  : 

in  String; 

Right  : 

in  Substring)  return 

Boolean; 

function  Length_Of 

(The_String  : 

in  String)  return 

Natural; 

function  Is_Null 

(The_S tring  : 

in  String)  return 

Boolean; 

function  Item_Of 

( The_String  : 

in  String; 

At_The_Position  ; 

in  Positive)  return 

Item; 

function  Substring__Of 

(The_S tring  ; 

in  String)  return 

Substring; 

function  Substring_Of 

(The^Strxng  ; 

in  String; 

Fron\JKie_Position  : 

in  Positive; 

To_The_Pos i tion  : 

in  Positive) return 

Substring; 


generic 

with  procedure  Process  (The_Item  :  in  Item; 

Continue  :  out  Boolean) ; 

procedure  Iterate  {Over_The_S tring  :  in  String); 

Overflow  ;  exception; 

Position_Error  :  exception; 

private 

type  Structure  is  access  Substring; 
type  String  is 
record 

The_Length  :  Natural  :=  0; 

The_Items  :  Structure; 
end  record; 

end  String_Seguential_Unbounded_Controlled_Iterator ; 
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STRING  SEQUENTIAL  UNBOUNDED  CONTROLLED  ITERATOR 
ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  svibdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Con?)uter 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

with  Storage_Manager_Se(3uential; 

package  body  String_SequentialJUnboimde<l_Controlled_Iterator  is 
type  Node; 

type  Node_Pointer  is  access  Node; 
type  Node  is 
record 

The_Structure  :  Structure; 

Next  :  Node_Po inter; 

end  record; 

type  Header; 

type  Header_Po inter  is  access  Header; 
type  Header  is 
record 

The^Size  :  Natural; 

The_Structures  :  Node^Pointer ; 

Next  :  Header_Pointer ; 

end  record; 

procedure  Free(The_Node  ;  in  out  Node)  is 
begin 

The_Node.The_Structure  :=  null; 
end  Free; 

procedure  Set_Next  (The^Node  :  in  out  Node; 

ToJJIext  :  in  Node__Po inter )  is 

begin 

TheJNode .  Next  :  =  To JNext ; 
end  SetJNext; 

function  Next_Of  (The_Node  :  in  Node)  return  Node_Pointer  is 
begin 

return  The_Node.Next ; 
end  Next_Of; 

package  Node_Manager  is  new  Storage_Manager_Sequential 

(Item  =>  Node, 

Pointer  *=>  Node_Pointer , 

Free  =>  Free, 

Set_Pointer  =>  Set_Next, 
Pointer_Of  =>  Next_Of ) ; 

procedure  Free(The_Header  :  in  out  Header)  is 
begin 

The_Header  .The_Size  :=;  0; 
end  Free; 

procedure  Set_Next  {The_Header  :  in  out  Header; 

ToJtJext  :  in  Header_Po inter)  is 

begin 

The_Header . Next  : =  To_Next ; 
end  SetJNext; 

function  Next_0f  (The_Header  :  in  Header)  return  Header_Pointer  is 
begin 

return  The_Header .Next; 
end  Next_Of; 

package  Header_Manager  is  new  Storage_Manager_Seguential 

(Item  =>  Header, 

Pointer  =>  Header_Po inter , 
Free  =>  Free, 

Set^Pointer  =>  SetJNext, 
Pointer_Of  =>  Next_0f ) ; 

task  StructureJManager  is 

entry  Free  {The_Structure  :  in  out  Structure) ; 

entry  Get^ew_Structure  (The^Size  :  in  Natural; 

The_Structure  :  out  Structure) ; 

end  StructureJManager; 

task  body  StructureJManager  is 

Free_List  :  Header_Po inter ; 

The_Structure  :  Structure; 

Node_Index  :  Node_Po  inter ; 

Previous_Header  :  Header_Pointer; 

Header_Index  :  Header_Po inter ; 

begin 

loop 

begin 

select 

accept  Free  (The_Structure  :  in  out  Struct\ire)  do 
Previous_Header  :=  null; 

Header_Index  :=  Free_List; 


while  Header_lndex  /=  null  loop 
if  The_Structure ‘Length  < 

Header_Index .  The_Si  ze  then 
exit  ; 

elsif  The^Stiructure ‘Length  = 
Header_Index.The„Size  then 

Node_Index  :=  NodeJManager  .New_Item; 
Node_Index . The_Struc ture  : = 


The_Structure; 


Header^Index . The^Struc tures ; 


Node_Index; 


Node_Index.Next  := 

Header^ Index . The_S true  tur es  i~ 


The^S true ture  :=  null; 
return; 
end  if; 

Previous_Header  :=  Header_Index; 
Header_Index  :  =  Header_Index .  Next ; 
end  loop; 

Header^Index  :=  Header^Manager  .NewjItem; 
Header_Index.The_Size  :=  The_S  true  ture 'Length; 
Node_Index  :=  Nodejlanager  .New_Item; 
Node_Index . The_S t rue  ture  ; =  The_S true ture ; 
Header_Index .  The_S  true  tures  :  =  Node_Index  ; 
if  Previous_Header  =  null  then 

Header_Index . Nex  t  : =  Free_Li s  t ; 

Free_List  :=  Header_Index ; 

else 

Header_Index.Next  :=  Previous_Header.Next; 
Previous_Header .Next  ;=  Header_Index; 
end  if; 

The_Structure  :=  null; 
end  Free; 


Structure)  do 


Header^Index , The_S true tures ; 
Node_Index . Next ; 


accept  GetJIew_S true ture  {The_Size  :  in 

The_Structure  :  out 

Previous_Header  :=  null; 

Header_Index  :=  Free_List; 
while  Header_Index  /=  null  loop 

if  Header _Index.The_Size  >=  The^Size  then 
Node^Index  : = 


Header_Index.The_Structures  :  = 


Node_Index.Next  null; 
if  Header_Index.The_S true tures  =  null 


Header_Index .  Next ; 


Node_Index . The_Struc  ture ; 


if  PreviousJHeader  =  null  then 
Free_List  := 

else 

PreviousJHeader . Next  : = 

Header  jindex . Next ; 
end  if; 

Header jindex . Next  : =  null ; 
Header^Manager  .Free{Header_Index) ; 
end  if; 

The_S  true  ture  ;  = 


Nodejlanager . Free (Node_Index) ; 
return; 
end  if; 

Previous Jieader  : =  Header_lndex ; 
Header_lndex  :=  Header_Index.Next; 
end  loop; 

The„Structure  :=;  new  Substring  (1  ..  Ihe^Size) ; 
end  GetjNeWjStructure; 


terminate ; 
end  select; 
exception 

when  StoragejError  «> 
null ; 

end; 

end  loop; 

end  Structurejianager ; 

procedure  Free  (The_S true ture  ;  in  out  Structure)  is 
begin 

if  The_Structure  /=  null  then 

Struc ture_Manager . Free ( The^S  true ture ) ; 
end  if; 
end  Free; 

function  New_Structure  (The_Size  :  in  Natural)  return  Structure  is 
Teitporary^Structure  :  Structure; 
begin 

StructureJManager  .Get  JSewjS  true  ture  (ThejSize, 

Tenporary_S  true  ture) ; 

return  Teitporary_S  true  ture; 
end  New_S true ture; 

procedure  Set  {The_.String  ;  in  out  String; 

Tojrhe_Size  ;  in  Natural; 

Preserve_The_Value  :  in  Boolean)  is 

Tenporary_S true ture  :  Structure; 
begin 
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if  To_The_Size  =  0  then 

Free (The_String . The„I terns ) ; 
elsif  The_Strxng.The_Iteins  =  null  then 

The_String.The_Itenis  :=  New„Structure(The_Sxze  => 
To_The_Size) ;  ^ 

elsif  To_The_Size  >  The_String.The_I terns 'Length  then 
if  Preserve_jrhe„Value  then 

Temporary's  true  ture  ; ~  New_S  true tur e { To_The_S i ze ) ; 
Teirporary^S  true  ture  (1  .  .  The_S  tr ing .  The_Length )  :  = 
The_String.The_Iteins(l  ..  The_String.The_Length) ; 
Free (The_S tring . The_Items ) ; 

The_String,The_I terns  :=  Tempor ary_S true ture; 

else 

Free ( The_S tring . The_I terns ) ; 

The_String.The_Items  :=  New_Strueture 

(The_Size  =>  To_The_Sxze) ; 


end  if; 
end  if; 

The_Str ing . The„Length 
exception 

when  Storage_Error  => 
raise  Overflow; 


To_The_Size ; 


end  Set; 


procedure  Copy  (From_The_S tring  :  in  String; 

To_The_String  :  in  out  String)  xs 

begin 

Set {To_The_S tring,  ^ 

To_The_Size  =>  FroituThe_String.The_Length, 

Preserve_The_Value  ->  False); 

To  The  String.The.Itemsd  ..  FronuThe_String.The_Length) 

FronuThe^S  tring .  The_I  terns  (1  . .  FronuThe_S  tring .  The^Length )  ; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Copy; 


procedure  Copy  (From_The_Subs tring  :  in  Sxibstring; 

To_The_S tring  :  in  out  String)  is 

begin 

Set  (To_The_S  tring,  ,  .  , 

To_The_S  i  ze  =>  Froin_The_Subs  tring  *  Leng  th , 

Preserve_The_Value  =>  False); 

To_The_S  tring .  The_I  tenvs  (1  .  .  Fr  oirL.The_Subs  t  r  xng '  Leng  th )  ;  = 
From_The_Subs  tring  ; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Copy; 

procedure  Clear  (The„S tring  : 
begin 

Set (The_S tring, 

To_The_Size  -> 

Preserve_The_Value  => 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Clear; 


in  out  String)  is 
0, 

False) ; 


procedure  Prepend  {The_String  :  in  String;  ^ 

To_The_S tring  :  in  out  String)  is 
Old^Length  :  Natural  :=  To_The_S  tring  .The^Length; 

New_Length  :  Natural  :=  .  t 

To_The_String.The_Length  +  The_Strxng,The_Length; 


begin 

Set (To_The_String, 

To_The_Size  =>  New_Length, 

Preserve_The_Value  =>  True) ; 

To_The_String.The_ltems  ( (The_String.The_Length  +  1)  .. 

New_Length)  ^ 

•=  To  The  String .The^I terns ( 1  ..  01d_Length) ; 
TolThe_itr ing . The_I terns { 1  . .  The_S  tring . The_Length)  :  = 
The^Str ing . The.Items (1  . .  The_String . The_Length) ; 
exception 

when  Storage_Error  => 
raise  Overflow; 


end  Prepend; 


procedure  Prepend  {The_Subs tring  :  in  Substring; 

To_The^S tring  :  in  out  String)  is 
01d_Length  ;  Natural  7=  To_The_S tring. The_Length; 

New_Length  :  Natural  :=  ,  t.  •  .r 

To_The_String.The_Length  +  The_Siabs tring  Length; 


begin 

Set (To_The_S tring, 

To_The_Size  =>  New_Length, 

Preserve„The_Value  =>  True) ; 

To_The_S tring . The_I terns ( ( The_Subs  tring ' Length  +  1 )  . . 
New_Length)  _  ,  ,  ,  _  . 

:  =  To_The_S tring .  The_l terns  {1  .  .  Old-Length) ; 
To_The_S tring .  The_I terns  (1  . .  The^Subs tring '  Length )  :  = 

The^Subs tring ; 
exception 

when  Storage„Error  => 
raise  Overflow; 
end  Prepend; 


procedure  Append  CThe_S tring  :  in  String; 

TO-.The_S tring  :  in  out  String)  is 
Old^Length  :  Natural” :=  To_The_S tring. The_Length; 

New-Length  :  Natural  :=  .  t 

To_The_String-The_Length  +  The_String.The_Length; 


begin 

Set (To_The_String, 

To_The_Size  =>  New_Length, 

Preserve_The_Value  =>  True) ; 

To_The_S tr ing  .The_I terns  ( (01d_Length  +1)  ..  New_Length) 


;=  The_String.The_Items(l  ..  The_String.The_Length) ; 
exception 

when  storage_Error  => 
raise  Overflow; 
end  Append; 

procedure  Append  (The-.Subs tring  :  in  Substring; 

To_The_String  :  in  out  String)  is 
Old-Length  :  Natural  :=  To_The_S tring. The^Length; 

New^Length  :  Natural  ;=  ,  . 

To_The_Str ing . The_Leng th  +  The_Subs tring  Length ; 

begin 

Se  t { To_The_S tring , 

To_The__Size  ->  New_Length, 

Preserve_The_Value  =>  True); 

To_The_String.The_Items(  {Old-Length  +  1)  ..  New_Length) 

;=  The_Substring; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  impend; 


procedure  Insert  (The_String 

In_The„String 


Old-Length 

New_Length 


:  in  String; 

:  in  out  String; 

At_The_Position  :  in  Positive)  is 

:  Natural  ;=  In_The_String.The_Length; 

:  Natural  ; = 

In„The_S  tring . The_Leng t h  + 

The_S  tring .  The_Length  ; 

EncLPosition  :  Natural  :=  .  _ 

At_The_Position  +  The_String.The_Length; 

At_The„Position  >  In_The_String.The_Length  then 
raise  Position_Error; 

else 

Set ( In_The_String, 

To^The^Size  =>  New_Length, 

Preserve_The-yalue  =>  True) ; 

In^The_String .  The_I  terns  ( EncLPos  ition  . .  New_Leng  th )  ;  = 
In_The_String.The_Items(At_The_Position  ..  01d_Length); 
In_The_String.The-Items(At_The-.Position  ..  (End-Position 


D)  :  = 


The_S  tring .  The_I  terns  { 1 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Insert; 


The_Str ing , The^Length ) ; 


procedure  Insert  {The_Sxabs tring 
In_The_S  tring 


01<d_Length 

New_Length 


:  in  Substring; 

_ _ _ _ _  :  in  out  String; 

At_The_Position  :  in  Positive)  is 

:  Natural  :=  In_The_S tring .The_Length; 

:  Natural  ; = 

In_The_S tring . The_Length  + 

rhe_S\ibs  tring '  Length; 

EndwPosition  :  Natural  ;=  . 

At_The_Position  +  The_Subs tring 'Length; 

begin 

if  At_The_Position  >  In-.The-.String.The_Length  then 
raise  Position_Error ; 

else 

Set  { ln-.The_Str  ing , 

To_The_Size  =>  New_Length, 

Preserve_The_Value  =>  True) ; 

In_The-.String. The„I terns {End_Position  ..  New_Length) 

In_'Ihe_S tring. The_I terns (At_The_Pos ition  ..  Old_Length)  ; 
In_The_String .  The_I terns  { At_The_Pos i t ion  . .  ( End-Position 

D)  :  = 

The-Subs  tring ; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Insert; 

procedure  Delete  ( In_The-S tring  :  in  out  String; 

Fron\_The_Position  :  in  Positive; 

TO— The_Pos ition  :  in  Positive)  is 

New-Length  :  Natural; 

^  if  {Froin_The_Position  >  In_The_String.The_Length)  or  else 
(To-The-Position  >  In-The_String.The-Length)  or  else 
(From-The-Position  >  To_The_Position)  then 
raise  Position_Error; 

else 

New_Length  :=  In-The-String.The_Length  - 

{To-The-Pos ition  -  FroiiuThe_Position  +  1) ; 
In— The— String. The_Iteins {From_The_Position  ..  New_Length) 

In_The_S  tring .  The-I  terns 
( {TO-The_Position  +1)  . 

Set {In-The-String, 

To_The_Size  => 

Preserve— The— Value  => 

end  if; 
exception 

when  Storage-Error  => 
raise  Overflow; 
end  Delete; 

procedure  Replace  (In-The-String  :  in  out  String; 

At-The-Position  :  in  Positive; 

With-The-String  :  in  String)  is 

End-Position  ;  Natural  :=  .  ,  ..t. 

At-The-Position  +  With-The-String.The-Length 


.  In-The-String. The— Length) ; 

New— Length, 

True)  ; 


begin 
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(The_String)  ; 


if  (At_The_Position  >  In_The_String.The_Length)  or  else 
{EndLPosition  >  In_The_String.The_Length)  then 
raise  Position^Error; 

else 

In_The_String.The_Items (At_The_Position  ..  EndLPosition) 

With-The_Str ing .  The_Items  {1  . . 

Wi  th_The_S tr ing . The_Length ) ; 
end  if; 
end  Replace; 


procedure  Replace  ( Iix_The_String  :  in  out  String; 

At_The_Position  ;  in  Positive; 

Witl\_The_Substring  :  in  Substring)  is 

EndLPosition  ;  Natural  := 

At_The„Position  +  With_The_Substring’ Length  - 


1; 

begin 

if  (At_The_Position  >  In_The_String.The_Length)  or  else 
(End-Position  >  In_The_String.The_Length)  then 
raise  Position_Error; 

else 

In_The_String.The_Iteins (At_The_Position  ..  EndLPosition) 


Wi t hLThe_Subs  tr ing ; 
end  if; 
end  Replace; 


procedure  SetLitem  ( InLThe_String  :  in  out  String; 

At_TheLPosition  ;  in  Positive; 

With_The_Item  :  in  Item)  is 

begin 

if  At^TheLPosition  >  In_TheLString.The_Length  then 
raise  Position_Error; 

else 

ln_TheLString.TheLltems(AtLThe_Position)  ;=  WithLThe_Item; 
end  if; 
end  Set_Item; 


modified  by  Vincent  Hong  and  Tusun  Nguyen 
date:  9  ;^ril  1995 

adding  procedures  to  replace  functions 

procedure  Is^Equal  (Left 

Right 
Result 

begin 

result  :=  Is^Equal  (Left, Right) ; 

end  ISLEqual; 


in  String; 
in  String; 
out  Boolean)  is 


begin 

result  Length^Of 
end  LengthLOf; 

procedure  Is^Null 

begin 

result  :=  Is_Null 
end  Is_JIull; 

procedure  ltem_Of 


begin 

result  : =  ItenuOf 
end  ItenuOf; 

procedure  SubstringLOf 

begin 

result  :=  Substring_Of  (TheLString) ; 
end  Substring_Of ; 

procedure  Substring_Of  (The_String  :  in  String; 

FronuTheLPosition  :  in  Positive; 
ToLThe_Position  ;  in  Positive; 
Result  :  out  Substring)  is 

begin 

result 

SubstringLOf  (The_String,Fronu'rheLPosition,  To_The_Position)  ; 
end  Substring_.Of ; 

—  end  of  modification 


(The_String  ;  in  String; 

Result  :  out  Boolean)  is 

(TheLString) ; 


(TheLString  :  in  String; 

At_The_Position  :  in  Positive; 

Result  :  out  Item)  is 

(TheLString, At_TheLPosition) ; 


(The_String  :  in  String; 

Result  :  out  Substring)  is 


function  Is_Equal  (Left  ;  in  String; 

Right  :  in  String)  return  Boolean  is 

begin 

if  Left  .The_Length  /=s  Right . The_Length  then 
return  False; 

else 

for  Index  in  1  . ,  Left.The_Length  loop 

if  Left.The_I  terns  (Index)  /=  Right  .The_l  terns  (Index) 


then 


return  False; 
end  if; 
end  loop; 
return  True; 
end  if; 
end  ISLEqual; 


procedure  Is_Equal  (Left 

Right 
Result 

begin 

result  :=  Is_Bqual  (Left, Right) ; 

end  Is_Equal; 


procedure  ISLEgual  (Left 

Right 
Result 

begin 

result  :=  Is^Equal  (Left, Right) ; 

end  Is^Equal; 


procedure  ISLLess_Than  (Left 
Right 
Result 

begin 

result  :=  Is_LessLThan  (Left, Right ) ; 
end  Is_LessLThan; 


procedure  Is_LessLThan  (Left 
Right 
Result 

begin 

result  :=  ls_Less_Than  (Left, Right) ; 
end  Is_Less_Than; 


procedure  laLLess^Than  (Left 
Right 
Result 

begin 

result  :=  ISLl*ess_Than  (Left, Right) ; 
end  ISLLess_Than; 

procedure  Is_Greater_Than  (Left 
Right 
Result 

begin 

result  :=  ISLGreater_Than  (Left, Right) ; 
end  Is_Greater_Than; 


procedure  ls_,Greater_Than  (Left 
Right 
Result 

begin 

result  :=  ls_GreaterLThan  (Left, Right) ; 
end  Is_Greater_Than; 


procedure  Is_Greater_Than  (Left 
Right 
Result 

begin 

result  :=  Is^GreaterLThan  (Left , Right) ; 
end  Is_GreaterLThan; 

procedure  Length^Of  (The_String 

Result 


:  in  Substring; 

:  in  String; 

;  out  Boolean)  is 


:  in  String; 

:  in  Substring; 

:  out  Booleemi)  is 


:  in  String; 

:  in  String; 

:  out  Boolean)  is 


:  in  Stabs  tr  ing; 

:  in  String; 

:  out  Boolean)  is 


:  in  String; 

;  in  Stabstring; 

:  out  Boolean)  is 


:  in  String; 

:  in  String; 

:  out  Booleaui)  is 


;  in  Substring; 

;  in  String; 

:  out  Boolean)  is 


;  in  String; 

:  in  Substring; 

;  out  Boolean)  is 


:  in  String; 

:  out  Natural)  is 


function  Is_Equal  (Left  ;  in  Substring; 

Right  :  in  String)  return  Boolean  is 

begin 

if  Left ‘Length  f-  Right -The_Length  then 
retuam  False; 

else 

for  Index  in  1  . .  Left 'Length  loop 

if  Left (Left ‘First  +  Index  -  1)  /= 

Right . The_l terns ( Index )  then 

return  False; 
end  if; 
end  loop; 
retuam  Tanae; 
end  if; 
end  Is_Equal; 


function  Is_Equal  (Left  :  in  String; 

Right  :  in  Substring)  return  Boolean  is 

begin 

if  Left .The_Length  /=  Right 'Length  then 
retuam  False; 


else 

for  Index  in  1  . .  Left .The_Length  loop 

if  Left.The^I terns (Index)  /=  Right (Right ' First  + 

-  1)  then 

return  False; 
end  if; 
end  loop; 
retuam  True; 
end  if; 
end  Is_Equal; 


Index 


function  ls_Less_Than  (Left  :  in  String; 

Right  :  in  String)  retuam  Boolean  is 

begin 

for  Index  in  1  . .  Left.The_Length  loop 
if  Index  >  Right . The_Length  then 
retuam  False; 

els  if  Left  .The_Items(  Index)  <  High  t.The_I  terns  (Index)  then 
retuam  Tanae; 

elsif  Right  .The^Items  (Index)  <  Left  .The_I terns  (Index)  then 
retuam  False; 
end  if; 

end  loop ; 

retuam  (Left.The_Length  <  Right .The_Length) ; 
end  Is_L€SS_Than; 


function  Is_Less_Than  (Left  :  in  Substring; 

Right  ;  in  String)  return  Boolean  is 

begin 

for  Index  in  1  . .  Left ‘Length  loop 
if  Index  >  Right .The_Length  then 
retuam  False; 

elsif  Left (Left ‘First  +  Index  -  1)  < 

Right . The_I terns ( Index )  then 
retuam  True; 

elsif  Right.  The_.I  terns  (Index)  <  Left  (Left 'First  +  Index  - 

1)  then 
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return  False; 
end  if; 
end  loop; 

return  (Left 'Length  <  Right .The_Length) ; 
end  Is_Less_Than; 


function  Is_Less_Than  (Left  :  in  Stringi- 

Right  :  in  Substring)  return  Boolean  is 

begin 

for  Index  in  1  . .  Left .The_Length  loop 
if  Index  >  Right 'Length  then 
return  False ; 

elsif  Left.The_I terns (Index)  <  Right (Right ‘First  +  Index  - 

1 )  then 

return  True; 

elsif  Right (Right ■ First  +  Index  -  1)  < 

Left . The^Items ( Index)  then 

return  False; 
end  if; 
end  loop; 

return  (Left.The_Length  <  Right 'Length)  ; 
end  Is_Less_Than; 

function  Is_Greater_Than  (Left  :  in  String; 

Right  :  in  String)  return  Boolean  is 

begin 

for  Index  in  1  . .  Left .The_Length  loop 
if  Index  >  Right . The_Length  then 
return  True; 

elsif  Left  .The_Iteins  (Index)  <  Right *The_I terns  (Index)  then 
return  False; 

elsif  Right.The_I  terns  (Index)  <  Left  .The_I  terns  (Index)  then 
return  True; 
end  if; 
end  loop; 
return  False; 
end  Is_Greater_Than; 


function  l5_Greater_Than  (Left  :  in  Substring; 

Right  :  in  String)  return  Boolean  is 

begin 

for  Index  in  1  . .  Left 'Length  loop 
if  Index  >  Right .The^Length  then 
return  True; 

elsif  Left (Left 'First  +  Index  -  1)  < 

Right .  The_I  tems  ( Index )  then 

return  False; 

elsif  Right.The_I tems (Index)  <  Left (Left 'First  +  Index  - 

1 )  then 

return  True; 
end  if; 
end  loop; 
return  False; 
end  Is_Greater_Than; 


function  Is_Greater_Than  (Left  :  in  String; 

Right  :  in  Substring)  return  Boolean  is 

begin 

for  Index  in  1  . .  Left .The_Length  loop 
if  Index  >  Right 'Length  then 
return  True; 

elsif  Left.The^ltems (Index)  <  Right (Right 'First  +  Index  - 

1)  then 

return  False; 


elsif  Right (Right 'First  +  Index  -  1)  < 

Left. The_I tems ( Index )  then 

return  True; 
end  if; 
end  loop; 
return  False; 
end  Is_Greater_Than ; 

function  Length_Of  (The^String  :  in  String)  return  Natural  is 
begin 

return  The_String,The_Length; 
end  Length_Of; 

f\mction  Is^ull  (The_String  :  in  String)  return  Boolean  is 
begin 

return  (The_String.The_Length  =  0); 
end  Is_Null; 

function  ItenuOf  (The_String  :  in  String ; 

At_The_Position  :  in  Positive)  return  Item  is 

begin 

if  At_The_Position  >  The_String.The_Length  then 
raise  PositiorL-Error; 

else 

return  The_S tring .  The_It ems  ( At_The_Pos i tion)  ; 
end  if; 
end  Item^Of; 

function  Substring_Of  (The_String  :  in  String)  return  Substring  is 
Teirporary_Structure  :  Siabstringd  1)  ; 

begin 

return  The_St ring. The_I tems (1  ..  The_String.The_Length) ; 
exception 

when  Constraint_Error  => 

return  Tenporary^S true tured  ..  0); 
end  Stjbstring_Of  ; 

function  Substring_Of  (The_String  :  in  String; 

From_The_Position  :  in  Positive; 

To_The_Position  ;  in  Positive)  retxim 

Substring  is 
begin 

if  (FroitL.The_Position  >  The_String.The_Length)  or  else 
(To_The_Position  >  The_String.The_Length)  or  else 
(FroirL.The_Position  >  To_The_Position)  then 
raise  Position^Error; 

else 

return  The_S tr ing .  The_l t ems  ( Fr om_The_Pos i t ion  . . 
To_The_Position) ; 
end  if; 

end  Substring_Of ; 

procedure  Iterate  (Over_The_String  :  in  String)  is 
Continue  ;  Boolean ; 
begin 

for  The_Iterator  in  1  . .  Over_The_String.The_Length  loop 
Process  (Over_The_S tring .  The_Items  (The_I terator ) , 

Continue) ; 

exit  when  not  Continue; 
end  loop; 
end  Iterate; 

end  String_Sequential_UnboundecLControlled_I terator ; 
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STRING  SEQUENTIAL  UNBOUNDED  CONTROLLED  ITERATOR 

PSDL 


TYPE  String_Sequential_Unbounded^Controlled_Iterator 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TYPE , 

Substring  ;  ARRAY [ARRAY^ELEMENT  :  Item,  ARRAY_INDEX  :  Positive], 
func_"<“  :  FXJNCTIONtLeft  :  Item,  Right  :  Item,  RETURN  :  Boolean] 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

From_The_String  :  String, 

To_The_String  :  String 
OUTPUT 

To_The_String  :  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Copy 
SPECIFICATION 
INPUT 

From_The_Substring  :  Substring, 

To_The_String  :  String 
OUTPUT 

To„The_String  :  String 
EXCEPTIONS 

Overflow,  Position^Error 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

Tbe_String  :  String 
OUTPUT 

The_String  :  String 
EXCEPTIONS 

Overflow,  PositionuError 

END 

OPERATOR  Prepend 
SPECIFICATION 
INPUT 

The_String  ;  String, 

To_The_String  :  String 
OUTPUT 

To__The_String  ;  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Prepend 
SPECIFICATION 
INPUT 

The_S\ibstring  :  Substring, 

To_The_String  :  String 
OUTPUT 

To__The_String  :  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Append 
SPECIFICATION 
INPUT 

The_String  :  String, 

To_The_String  :  String 
OUTPUT 

To_The_String  :  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Append 
SPECIFICATION 
INPUT 

The_Substring  :  Sxibstring, 

To_The_String  :  String 
OUTPUT 

To_The_String  :  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Insert 
SPECIFICATION 
INPUT 

The_String  :  String, 

In>,The_S  t  r  ing  :  S  tr  ing , 

At_The_Position  :  Positive 
OUTPUT 

In_The_String  :  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 


OPERATOR  Insert 
SPECIFICATION 
INPUT 

The_Substring  :  Substring, 
In^The_String  :  String, 


At_The_Position  :  Positive 
OUTPUT 

In_I^e_String  :  String 
EXCEPTIONS 

Overflow,  Position^Error 


OPERATOR  Delete 

SPECIFICATION 

INPUT 

ln«The_String  :  String, 

Froii\_The_Position  ;  Positive, 

To_The_Position  ;  Positive 
OUTPUT 

In_The_String  :  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Replace 

SPECIFICATION 

INPUT 

In_The_String  :  String, 

At_The_Position  :  Positive, 

With_The_String  :  String 
OUTPUT 

In_The_String  :  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 


OPERATOR  Replace 
SPECIFICATION 
INPUT 

In_The_String  :  String, 
At_The_Position  :  Positive, 
With_The_S\ibstring  :  Stibstring 
OUTPUT 

In_The_String  :  String 
EXCEPTIONS 

Overflow,  Position^Error 

END 


OPERATOR  Set_Item 
SPECIFICATION 
INPUT 

In_The_String  :  String, 
At_The_Position  :  Positive, 
With_The_Item  ;  Item 
OUTPUT 

In_The_String  :  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 


OPERATOR  IS^Equal 

SPECIFICATION 

INPUT 

Left  :  String, 

Right  :  String 
OUTPUT 

Result  ;  Boolecin 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Is^Equal 

SPECIFICATION 

INPUT 

Left  :  Substring, 

Right  :  String 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  IS_Equal 

SPECIFICATION 

INPUT 

Left  :  String, 

Right  :  Substring 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Position_Error 

END 


OPERATOR  Is_Less_Than 
SPECIFICATION 
INPUT 

Left  ;  String, 

Right  :  String 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Position_Error 

END 
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OPERATOR  Is_Less_Than 

SPECIFICATION 

INPUT 

Left  :  Substring, 

Right  :  String 
OUTPUT 

Result  ;  Boolean 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Is_Less_Than 

SPECIFICATION 

INPUT 

Left  :  String, 

Right  :  Svibstring 
OUTPUT 

Result  ;  Boolean 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Is_Greater_Than 

SPECIFICATION 

INPUT 

Left  :  String, 

Right  :  String 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Is_Greater_Than 

SPECIFICATION 

INPUT 

Left  :  Substring, 

Right  :  String 
OUTPUT 

Result  :  Booleaui 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Is_Greater_Than 

SPECIFICATION 

INPUT 

Left  :  String, 

Right  :  Substring 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Position^Error 

END 

OPERATOR  Length_Of 

SPECIFICATION 

INPUT 

The_String  :  String 
OUTPUT 

Result  :  Natural 


EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Is_Null 

SPECIFICATION 

INPUT 

The_String  ;  String 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  ItenuOf 

SPECIFICATION 

INPUT 

The_String  :  String, 

At_The_Position  :  Positive 
OUTPUT 

Result  :  Item 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Substring_Of 

SPECIFICATION 

INPUT 

The_String  :  String 
OUTPUT 

Result  :  Sxibstring 
EXCEPTIONS 

Overflow,  Position^Error 

END 

OPERATOR  Substring_Of 

SPECIFICATION 

INPUT 

The_String  :  String, 

FrortuThe_Position  :  Positive, 

Tojrhe_Position  :  Positive 
OUTPUT 

Result  :  Substring 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Iterate 

SPECIFICATION 

GENERIC 

Process  ;  PROCEDURE [The_I tern  :  init  :  Item],  Continue  :  out[t 
Boolean] 1 
INPUT 

Over_The_String  :  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 

END 

IMPLEMENTATION  ADA  String_Sequential_Unbounded_ControllecLIterator 
END 
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STRING  SEQUENTIAL  UNBOUNDED  MANAGED  ITERATOR 
ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

type  Siibstring  is  array  (Positive  range  <>)  of  Item; 
with  function  "<"  (Left  :  in  Item; 

Right  :  in  Item)  return  Boolean; 
package  String_Sequential_Unboimde{iJlanaged_Iterator  is 


type  String  is  limited  private; 


procedure  Copy 

procedure  Copy 

procedure  Clear 
procedure  Prepend 

procedure  Prepend 

procedure  Append 

procedure  Append 

procedure  Insert 

procedure  Insert 

procedure  Delete 

procedure  Replace 

proced\ire  Replace 

procedure  Set_ltem 


{ From_The_S tring 
To_The_String 
{ From-.The_Subs  tring 
To_The_S  t  r  ing 
(The_S tring 
{The_String 
To_The_String 
( The_Subs  tring 
To_The_String 
(The_S tring 
To_The_String 
( 11ie_Subs  tring 
To_'nie_String 
(The_String 
In_The_String 
At_The_Pos it ion 
(The^Substring 
In_The_String 
At_The_Position 
( In_'nie_String 
From_The_Position 
To_'IhLe_Pos  ition 
( In_'nie_String 
At_Tlie_Pos  ition 
With^The_String 
( In_The_String 
At_The_Pos ition 
Wi th_The_Subs  tring 
( ln_The_S tring 
At_The_Position 
With_The_Item 


in 

String; 

in  out 

String) ; 

in 

Substring; 

in  out 

String) ; 

in  out 

String) ; 

in 

String; 

in  out 

String) ; 

in 

Substring; 

in  out 

String ) ; 

in 

String ; 

in  out 

String ) ; 

in 

Substring; 

in  out 

String) ; 

in 

String ; 

in  out 

String ; 

in 

Positive) ; 

in 

Substring; 

in  out 

String; 

in 

Positive) ; 

in  out 

String; 

in 

Positive; 

in 

Positive) ; 

in  out 

String ; 

in 

Positive; 

in 

String) ; 

in  out 

String; 

in 

Positive; 

in 

Substring) 

in  out 

Stringi- 

in 

Positive; 

in 

Item) ; 

modified  by  Vincent  Hong  and  Tuan  Nguyen 

—  date:  9  April  1995 

—  adding  procedures  to  replace  f\inctions 


procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 


Is«.Egual 

(Left 

in  String; 

Right 

in  Stringi- 

Result 

out  Booleein)  ; 

Is^Equal 

(Left 

in  Substring; 

Right 

in  String; 

Result 

out  Booleein)  ; 

Is_Equal 

(Left 

in  String; 

Right 

in  Substring; 

Result 

out  Boolean) ; 

Is_Less_Than 

(Left 

in  String; 

Right 

in  String; 

Result 

out  Boolean) ; 

Is_Less_Than 

(Left 

in  Substring ; 

Right 

in  String; 

Result 

out  Boolean) ; 

Is_Less_Than 

(Left 

in  String; 

Right 

in  Subs tring ; 

Result 

out  Boolean) ; 

Is_Greater_Than 

(Left 

in  String; 

Right 

in  String; 

Result 

out  Boolean) ; 

ls_Gr ea  terjThan 

(Left 

in  Substring; 

Right 

in  String; 

Result 

out  Boolean) ; 

Is_Greater_Than 

(Left 

in  String ; 

Right 

in  Substring; 

Result 

out  Boolean) ; 

procedure  Length_Of 

(The_S tring 

:  in  String ; 

Result 

:  out  Natural) ; 

procedure  IsJKull 

(The_S tring 

:  in  String ; 

Result 

:  out  Boolean) ; 

procedure  ItenuOf 

(The^String 

;  in  String; 

At_The_Position 

:  in  Positive ; 

Result 

:  out  Item)  ; 

procedure  Sxibstring_Of 

(The_S tring 

;  in  String; 

Result 

;  out  Substring) ; 

procedure  SubstringjOf 

(The_S tring 

:  in  String ; 

FroitL.The_Pos  ition 

:  in  Positive; 

To_The_Po  s i t ion 

;  in  Positive; 

—  end  of  modification 

Result 

;  out  Slabstring)  ; 

function  Is_Equal 

(Left  : 

in  String; 

Boolean; 

Right  ; 

in  String)  return 

function  Is_Equal 

(Left  : 

in  Slabstring; 

Boolean; 

Right  ; 

in  String)  return 

function  Is_Equal 

(Left  : 

in  String; 

Boolean; 

Right  : 

in  Substring)  return 

function  Is_Less_Than 

(Left  : 

in  String; 

Boolean; 

Right  : 

in  String)  return 

function  Is_Less„Than 

(Left  : 

in  Substring; 

Boolean; 

Right  : 

in  String)  return 

function  Is„Less_Than 

(Left  : 

in  String; 

Boolean; 

Right  : 

in  Substring)  return 

function  Is_Greater_Than 

(Left  : 

in  String; 

Boolean; 

Right  : 

in  String)  return 

function  Is_Greaterjrhan 

(Left  : 

in  Substring; 

Boolean; 

Right  : 

in  String)  return 

function  Is_Greater_Than 

(Left  : 

in  String; 

Boolean; 

Right  : 

in  Substring)  return 

function  Length^Of 
Natural ; 

(The_S tring  ; 

in  String)  return 

function  Is^Null 

Boolean ; 

(The_S tring  ; 

in  String)  return 

function  Item_Of 

(The_S tring  ; 

in  String; 

Item; 

At_The_Position  ; 

in  Positive)  return 

function  Substring_Of 
Substring; 

(The_S tring  ; 

in  String)  return 

function  Substring_Of 

(The^String  ; 

in  String ; 

Fron\_The_Position  : 

in  Positive; 

Substring; 

generic 

To_The_Pos ition  ; 

in  Positive) return 

with  procedure  Process  {The_Item  :  rn  Item; 

Continue  :  out  Boolean) ; 

procedure  Iterate  (Over_The_S tring  ;  in  String) ; 

Overflow  :  exception; 

Position_Error  :  exception; 


private 

type  Structure  is  access  Substring; 
type  String  is 
record 

The_Jiength  :  Natural  :=  0; 

The_l terns  :  Structure; 
end  record; 

end  String_Sequential_UnboundedJIanaged_lterator ; 
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STRING  SEQUENTIAL  UNBOUNDED  MANAGED  ITERATOR 

PSDL 


TYPE  String_Sequential_Unboiande<OIanagec3LIterator 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TYPE,  .  .  , 

Substring  :  ARRAY [ARRAy_ELEMENT  :  Item,  ARRAY_INDEX  :  Positive], 
:  FUNCTIONfLeft  :  Item,  Right  :  Item,  RETURN  :  Boolean] 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

From_The_String  :  String, 

To_The_String  :  String 
OUTPUT 

To_The_String  :  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 


OPERATOR  Copy 
SPECIFICATION 
INPUT 

Fron\_The_Substring  :  Substring, 
To_The_String  :  String 
OUTPUT 

To_The_String  :  String 
EXCEPTIONS 

Overflow,  Posit ion_Error 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The^String  ;  String 
OUTPUT 

The_String  ;  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Prepend 
SPECIFICATION 
INPUT 

The_String  :  String, 
To_The_String  ;  String 
OUTPUT 

To_The_String  :  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Prepend 
SPECIFICATION 
INPUT 

The_Siibstring  ;  Substring, 
To_The_String  ;  String 
OUTPUT 

To_The_String  :  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Append 
SPECIFICATION 
INPUT 

The_String  :  String, 
To_The_String  :  String 
OUTPUT 

To_The_String  ;  String 
EXCEPTIONS 

Overflow,  Position^Error 

END 

OPERATOR  ;^pend 
SPECIFICATION 
INPUT 

The_Substring  :  Substring, 
To_The_String  :  String 
OUTPUT 

To_The_String  :  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Insert 
SPECIFICATION 
INPUT 

The_String  :  String, 
In_The_String  :  String, 
At_The_Position  :  Positive 
OUTPUT 

In_The_String  :  String 
EXCEPTIONS 

Overflow,  Posit ion_Error 

END 

OPERATOR  Insert 
SPECIFICATION 
INPUT 

The_Substring  :  Substring, 
In_The_String  :  String, 


At_The_Position  :  Positive 
OUTPUT 

In_The_String  :  String 
EXCEPTIONS 

Overflow,  Position_Error 


OPERATOR  Delete 

SPECIFICATION 

INPUT 

In_The_String  :  String, 

FronL.The„Position  :  Positive, 

To_The_Position  ;  Positive 
OUTPUT 

In_The_String  :  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Replace 

SPECIFICATION 

INPUT 

In^The_String  :  String, 

At_The_Position  :  Positive, 

With_The_String  :  String 
OUTPUT 

In_The_String  :  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Replace 

SPECIFICATION 

INPUT 

In_The_String  :  String, 

At_The_Position  :  Positive, 

With_The_Substring  :  Substring 
OUTPUT 

In_The_String  :  String 
EXCEPTIONS 

Overflow,  Posit ion_Error 

END 


OPERATOR  Set^Item 

SPECIFICATION 

INPUT 

In_The_String  :  String, 

At_The_Position  :  Positive, 

With_The_Item  :  Item 
OUTPUT 

In^The_String  :  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Is_Equal 

SPECIFICATION 

INPOT 

Left  :  String, 

Right  :  String 
OUTPUT 

Result  ;  Boolean 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  IS_Equal 

SPECIFICATION 

INPUT 

Left  :  Substring, 

Right  ;  String 
OOTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Is_Equal 

SPECIFICATION 

INPUT 

Left  :  String, 

Right  ;  Substring 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Position^Error 

END 


OPERATOR  Is_Less_Than 
SPECIFICATION 
INPUT 

Left  ;  String, 

Right  :  String 
OOTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Position_Error 

END 
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OPERATOR  Is_Less_Than 

SPECIFICATION 

INPUT 

Left  :  S\ibstring, 

Right  :  String 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Is„Less_Than 

SPECIFICATION 

INPUT 

Left  :  String, 

Right  :  Substring 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Position_Error 

END 


OPERATOR  Is_Greater_Than 

SPECIFICATION 

INPUT 

Left  :  String, 

Right  :  String 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Is_Greater_Than 

SPECIFICATION 

INPUT 

Left  :  Substring, 

Right  :  String 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Is_Greater_Than 

SPECIFICATION 

INPUT 

Left  :  String, 

Right  :  Substring 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Posit ion_Error 

END 

OPERATOR  Length^Of 

SPECIFICATION 

INPUT 

The_String  :  String 
OUTPUT 

Result  :  Natural 


EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  IS_Null 

SPECIFICATION 

INPUT 

The_String  :  String 
OUTPUT 

Result  :  Boolecin 
EXCEPTIONS 

Overflow,  Position__Error 

END 

OPERATOR  ItenuOf 

SPECIFICATION 

INPUT 

The_String  :  String, 

At_The_Position  :  Positive 
OUTPUT 

Result  :  Item 
EXCEPTIONS 

Overflow,  Position^Error 

END 

OPERATOR  Substring^Of 

SPECIFICATION 

INPUT 

The^String  :  String 
OUTPUT 

Result  ;  Substring 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Substring_Of 

SPECIFICATION 

INPUT 

The_String  :  String, 

FronL.The_Position  :  Positive , 

To_The_Position  :  Positive 
OUTPUT 

Result  :  Substring 
EXCEPTIONS 

Overflow,  Position^Error 

END 

OPERATOR  Iterate 

SPECIFICATION 

GENERIC 

Process  :  PROCEDURE  I The_I tern  :  in(t  ;  Item],  Continue  :  out[t  : 
Boolean] ] 

INPUT 

Over_The_String  :  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 

END 

IMPLEMENTATION  ADA  String_Sequential_UnboundedJIaiiagecLIterator 
END 
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STRING  SEQUENTIAL  UNBOUNDED  UNMANAGED  NONITERATOR 

ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

type  S\ibstring  is  array  (Positive  range  <>)  of  I  tern; 
with  fxmction  •<"  (Left  :  in  Item; 

Right  :  in  Item)  return  Boolean; 

package  string_Se<3uential_Unboundedi_Uninanaged_Noniterator  is 


type  String  is  limited  private; 


procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 


Copy 

( FronuThe.String 

in 

String; 

To_The_String 

in 

out 

String) ; 

Copy 

( From_The_Subs tr ing 

in 

Svibstring; 

To_The_S  tr ing 

in 

out 

String) ; 

Clear 

(The„String 

in 

out 

String) ; 

Prepend 

(The_String 

in 

String; 

To_The_String 

in 

out 

String) ; 

Prepend 

{ The_Subs  tr ing 

in 

Substring; 

To_The_S  t  r  ing 

in 

out 

String) ; 

Append 

(The_String 

in 

String; 

To_The_S  tr ing 

in 

out 

String) ; 

Append 

(The^Substring 

in 

Substring; 

To_The_String 

in 

out 

String) ; 

Insert 

(The_String 

in 

String; 

In_The_S  tr ing 

in 

out 

String; 

At_The_Position 

in 

Positive) ; 

Insert 

(The_Substring 

in 

Substring; 

m_The_String 

in 

out 

String; 

At_The_Pos i t i on 

in 

Positive) ; 

Delete 

( In_The_String 

in 

out 

String; 

Fron\_The_Pos  i  t  ion 

in 

Positive; 

To_The_Position 

in 

Positive) ; 

Replace 

( ln_The_String 

in 

out 

String; 

At_The_Position 

in 

Positive; 

Wi th_The_S tr ing 

in 

String) ; 

Replace 

( In_The_String 

in 

out 

String; 

At_The_Posi t ion 

in 

Positive; 

Wi th_The_Subs t r ing 

in 

Substring) 

Set^Item 

( In_The_Str ing 

in 

out 

Stringi- 

At_The_Pos i t ion 

in 

Positive; 

With_The_Item 

in 

Item)  ; 

—  modified  by  Vincent  Hong  and  Tuan  Nguyen 

—  date:  9  April  1995 

—  adding  procedures  to  replace  functions 


procedure  Is_Equal  (Left 

Right 
Result 

procedure  Is^Equal  (Left 

Right 
Result 

procedure  Is^Equal  (Left 

Right 
Result 

procedure  Is_Less_Than  (Left 

Right 
Result 

procedure  ls_Less_Than  (Left 

Right 
Result 

procedure  Is_Less_Thcin  (Left 

Right 
Result 


procedure  Is_Greater_Than  (Left 
Right 
Result 

procedure  Is_Greater_Than  (Left 
Right 
Result 

procedure  Is_Greater_Than  (Left 


in  String; 
in  String; 
out  Boolean) ; 
in  Substring; 
in  String; 
out  Boolean) ; 
in  String; 
in  Substring; 
out  Boolean) ; 
in  String; 
in  String; 
out  Boolean) ; 
in  Substring; 
in  String; 
out  Boolean) ; 
in  String; 
in  Substring; 
out  Boolean) ; 
in  String; 
in  String; 
out  Boolean) ; 
in  S\ibstring; 
in  String; 
out  Boolean) ; 
in  String; 


procedure  Length_Of 
procedure  Is^Null 
procedure  Item_Of 


procedure  Substring_Of 
procedure  Substring__Of 


Right 
Result 
(The_String 
Result 
(The_String 
Result 
(The_String 
At_The_Posi tion 
Result 
(The_String 
Result 
{The_String 
Fr  oro_The__Pos  i  tion 
To_The_Pos i t ion 
Result 


in  Substring; 
out  Boolean) ; 
in  String; 
out  Natural); 
in  String; 
out  Boolean) ; 
in  String; 
in  Positive; 
out  Item)  ; 
in  String; 
out  Substring) ; 
in  String; 
in  Positive; 
in  Positive; 
out  Substring) ; 


end  of  modification 


function 

Boolean; 

function 

Boolean; 

function 

Boolean; 

fxinction 

Boolean; 

function 

Boolean; 

function 

Boolean; 

function 

Boolean; 

function 

Boolean; 

fiinction 

Boolean; 

fimction 

Natural ; 

function 

Boolean; 

function 

I  tern; 

function 

Substring; 

function 


Is_Equal 

(Left 

:  in 

String; 

Right 

:  in 

String) 

return 

Is_Equal 

(Left 

:  in 

S\ibstring; 

Right 

:  in 

String) 

return 

Is_Equal 

(Left 

:  in 

String; 

Right 

:  in 

Substring) 

return 

Is_Less_Than 

(Left 

:  in 

String; 

Right 

:  in 

String) 

return 

Is_Less_Than 

(Left 

;  in 

Substring; 

Right 

:  in 

String) 

return 

ls_Less_Than 

(Left 

:  in 

String; 

Right 

:  in 

Substring) 

return 

Is_Gr ea t er_Than 

(Left 

:  in 

String; 

Right 

:  in 

String) 

return 

Is_Greater_Thein 

(Left 

:  in 

Substring; 

Right 

:  in 

String) 

return 

Is_Greater_Than 

(Left 

:  in 

String; 

Right 

:  in 

Substring) 

return 

Length_0f 

(The_String 

:  in 

String) 

return 

IsJNull 

(The_String 

:  in 

String) 

return 

ItenuOf 

(The_String 

:  in 

Stringy- 

return 

A t_The_Pos i t ion 

;  in 

Positive) 

Substring_Of 

(The_String 

:  in 

String)  return 

Substring_Of 

(The_String 
FroitL_The_Position  : 

:  in 
:  in 

Stringy- 
Positive  ; 

To_The_Pos i t ion 

:  in 

Positive) return 

Substring; 


Overflow  :  exception; 

Position_Error  :  exception; 


private 

type  Structure  is  access  Siibstring; 
type  String  is 
record 

The_Length  :  Natural  :=  0; 

The_Items  :  Structure; 
end  record; 

end  string_Sequential_Unbounded_Uninanaged_Noniterator ; 
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STRING  SEQUENTIAL  UNBOUNDED  UNMANAGED  NONITERATOR 

ADA  IMPLEMENTATION 


—  {C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Ntmber  0100219 

•Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  sijbdivision  (b)  (3)  {ii) 

—  of  the  rights  in  Technical  Data  and  Computer 

—  Software  Clause  of  PAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body  String_Sequential_UnboundecLUninanagecLNoniterator  is 

procedure  Set  (The_String  :  in  out  String; 

To_The_Size  :  in  Natural; 

Preserve__The_Value  ;  in  Boolean)  is 

Tenporary_Structure  :  Structure; 
begin 

if  To„The_Size  =  0  then 

The_S t r ing .  The_I  terns  :  =  nu  1 1  ; 
elsif  The_String.The_I terns  =  null  then 

The_String.The_I terns  :=  new  Substring (1  To_The_Size)  ; 

elsif  To_The_Size  >  The_String.The_I terns ’Length  then 
if  Preserve_The_Value  then 

Tenporary_Structure  new  Substring (1  .. 

To_The_Size) ; 

Teinporary_Structure ( 1  ..  The_String.The_Length)  ;  = 
The_S  t r ing . The„I terns (1  . .  The_S t r ing . The_Leng t h ) ; 
The_String.The_I terns  :=  Temporary_Structure ; 

else 

The_Str ing. The_I terns  :=  new  Slabs t r ing (1  .. 

To_The_Size) ; 

end  if; 
end  if; 

The_String.The_Length  :=  To_The_Size; 
end  Set; 

procedure  Copy  (From_The_String  :  in  String; 

To_The_String  :  in  out  String)  is 

begin 

Set (To_The_Str ing , 

To_The_Size  =>  From_The_String.The_Length, 

Preserve_The_Value  =>  False) ; 

To_The_Str  ing .  The_I terns  (1  . .  FronuThe_String .  The_Length )  :  = 
FronL.The_String.The_Items(l  ,.  FromL_The_String.The_Length)  ; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Copy; 

procedure  Copy  (Frorn_The_Substring  :  in  Substring; 

To_The_String  :  in  out  String)  is 

begin 

Se  t { To_The_S tr ing , 

To_The_Size  =>  From_The_Substring’ Length, 

Preserve_The_Value  =>  False); 

To_The_String.The_Items{l  ..  Frorn_The_Substring* Length)  :  = 
Frora_The_Substring ; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Copy; 

procedure  Clear  {The_String  : 
begin 

Set (The_String, 

To_The_Size  => 

Preserve_The_Value  => 
end  Clear; 

procedure  Prepend  (The^String  ;  in  String; 

To_The_String  :  in  out  String)  is 
OldLLength  :  Natural  ;=  To_The_String.The_Length; 

New_Length  :  Natural  ;= 

To_The_String . The_Length  +  The_String . The_Length ; 

begin 

Se  t ( To_The_S tr ing , 

To_The_Size  =>  New_Length, 

Preserve_The_Value  =>  True) ; 

To_The_String,The_Items( (The_String.The_Length  +  1)  .. 

New_L€ngth) 

:=  To_The_S  tr  ing.  The_I  terns  (1  ..  Old^Length); 
To_The_String.The_Items(l  The_String.The_Length)  := 
The_String.The_Items(l  ..  The_String.The_Length) ; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Prepend; 

procedure  Prepend  (The_Substring  :  in  Substring; 

To_The_String  :  in  out  String)  is 
Old_Length  :  Natural  ;=  To_The_String.The_Length; 

New_Length  :  Natural  := 

To_The_S tr ing . The_Leng th  +  The_Substring ■ Length ; 

begin 

Se  t ( To_The_S tr ing , 


To_The_Size  =j>  New_Length, 

Preserve_The_Value  =>  True) ; 

To_The_String.The_Iteins(  (The_Substring 'Length  +  1)  .. 
New_Length) 

:=  To_The_Str ing. The_I terns (1  ..  01d_Length); 
To_The_String.The_Items(l  ..  The_Substring' Length)  := 

The_Subs  t r ing ; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Prepend; 

procedure  Append  (The_String  :  in  String; 

To_The_String  :  in  out  String)  is 
OlcSLLength  ;  Natural  To_The_String.The_Length; 

New_Length  :  Natural  := 

To_The_String.The_Length  +  The_String.The_Length; 

begin 

Set ( To_The_S tr ing , 

To_The_Size  =>  New_Length, 

Preserve_The_Value  =>  True) ; 

To_The_String.’rhe_Iteins  ( (OldLLength  +1)  ..  New_Length) 

;  =  ’rhe_String .  The_I  terns  (1  . .  The_S  tr  ing .  TheJLength )  ; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Append; 

procedure  Append  (The_Substring  :  in  Substring; 

To_The_String  :  in  out  String)  is 
01d_Length  :  Natural  To_The_String.The_Length; 

NewJLength  :  Natural  := 

To_The_S  tr  ing .  The_Lengt  h  +  The_Subs  t  r  ing  ‘  Length ; 

begin 

Set (To_The_String, 

To_The_Size  ->  New_Length, 

Preserve_The„Value  ->  True) ; 

To_The_String.The_Items ( {01d_Length  +1)  ..  New_Length) 

The_Substring; 

exception 

when  Storage_Error  => 
raise  Overflow; 
end  Append; 

procedure  Insert  (The_String  :  in  String; 

In_The_String  :  in  out  String; 

At_The_Position  :  in  Positive)  is 
01d„Length  :  Natural  :=  In_The_String.The_Length; 

New_Length  :  Natural  := 

In_The_S  tr  ing .  The_Leng  th  + 

The_String . The_Leng th ; 

EndLPosition  :  Natural  :® 

At_The_Position  +  The_String.The_Length; 

begin 

if  At_The_Position  >  Iru.The_String.The_Length  then 
raise  Position_Error; 

else 

Set { In_The_Str ing , 

To_The_Size  =>  New_Length, 

Preserve_The_Value  =>  True) ; 

In_The_String.The_Items  (End-Position  ..  New_Length)  :» 

In— The_String.The_Itenis(At_The_Position  ..  OlcLJiength) ; 
In  The_String.The_I terns  (At_The_Position  ..  (End-Position  - 

D)  :  = 

The_S  t r  ing .  The_I  terns  (1  . .  Th€_S  t r ing .  The_Leng  th )  ; 
end  if; 
exception 

when  Storage— Error 
raise  Overflow; 
end  Insert; 

procedure  Insert  (The-Substring  ;  in  Substring; 

In_The-String  :  in  out  String; 

At-The_Position  :  in  Positive)  is 
Old-Length  :  Natural  :=  In-The_String.The_Length; 

New-Length  :  Natural 

In-The_S  tr  ing .  The_Leng  t  h  + 

The-Substring ' Length; 

End-Position  ;  Natural  := 

At-The_Position  +  The-Substring ’Length ; 

begin 

if  At-The-Position  >  In_The_String-The-Length  then 
raise  Position-Error; 

else 

Set ( In_The-String, 

To-The-Size  =>  New-Length, 

Preserve— The— Value  =>  True) ; 

In-The_S  tr  ing.  The-I  terns  (EndLPosition  ..  New_Length)  :  = 
In-The-String. The-I terns (At_The_Position  ..  Old-Length); 
In_Th€-String.The-I terns  (At-The-Position  ..  (End-Position  - 

D)  :  = 

The-Substring; 
end  if; 
exception 

when  Storage— Error  => 
raise  Overflow; 
end  Insert; 

procedure  Delete  (In— The— String  :  in  out  String; 


in  out  String)  is 
0, 

False) ; 
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FronL.The_Position  :  in  Positive; 

To_The_Position  :  in  Positive)  is 

New^Iicngth  :  Natural; 
begin 

if  (FronuThe_Position  >  In_The_String .The_Length)  or  else 
(To_The_Position  >  Injrhe_String,The_Length)  or  else 
{FronL.The_Position  >  To_The_Position)  then 
raise  Position^Error; 

else 

New  Length  :=  In^The_String.The_Length  - 

~  (To_The_Position  -  FronL,The_Position  +1); 

In_The_S tring.The_I terns (FrortuThe_Posit ion  ..  New_Length) 

In_The_Str  ing .  The_I  terns 

( (To_The_Position  +1)  In_The_String.The_Length) ; 
Set ( In_The_String, 

To_The_Si2e  =>  New_Length, 

Preserve_The_Value  =>  True) ; 

end  if; 
end  Delete; 


procedure  Replace  (In_The_String  :  in  out  String; 

At_The_Position  :  in  Positive; 

With_The_String  :  in  String)  is 

End^Position  :  Natural 

At_The_Position  +  With_The_Strxng.The_Length  - 

1; 

begin 

if  (At_The_Position  >  In_The_String.The_Length)  or  else 
(EncLPosition  >  In_The_String.The_Length)  then 
raise  Position_Error; 

else  ,  .  .  , 

In_The_String.The_Items(At_The_Position  ..  End_Position) 

Wi  thL_The_Str  ing .  The„I  terns  (1  . . 
With_The_String.The_Length)  ; 
end  if; 
end  Replace; 


procedure  Replace  (In_The_String  :  in  out  String; 

At_The„Position  ;  in  Positive; 

With_The_Substring  :  in  Substring)  is 

End_Position  :  Natural  := 

At_The_Position  +  With_The_Substring* Length  - 


begin 

if  (At_The_Position  >  In_The_String.The_Length)  or  else 
(End_Position  >  In_The_String.The_Length}  then 
raise  Position__Error ; 

else  ,  .  .  , 

In_The_S tring .  'Ilie_I terns  ( At_The_Pos i tion  . .  End_Posxtion ) 


With_The_Substring ; 
end  if; 
end  Replace; 


procedure  Set_Item  {In_The_String  :  in  out  String; 

At_The„Position  :  in  Positive; 

With_The„Item  :  in  Item)  is 

if  At_The_Position  >  In_The_String.The_Length  then 
raise  Position_Error ; 


else 

In_The__String  .The_I  terns  (At_The_Positaon) 
end  if; 
end  Set_Item; 


Wi  th_The_I  tern ; 


—  modified  by  Vincent  Hong  and  Tuan  Nguyen 

—  date:  9  April  1995 

adding  procedures  to  replace  functions 


procedure  Is_Equal 


begin 

result  :=  Is_Equal 
end  Is_Equal; 


(Left 

Right 

Result 

(Left, Right) ; 


procedure  Is_Equal 


begin 

result  ;=  Is_Equal 
end  Is^Equal; 

procedure  Is_Equal 


begin 

result  : =  Is_Equal 
end  Is_Equal; 


(Left 

Right 

Result 

(Left, Right) ; 


(Left 

Right 

Result 

(Left, Right)  ; 


procedure  Is_Less_Than 


(Left 

Right 

Result 


begin 

result  : =  Is_Less_Than 
end  Is_Less_Than; 


(Left, Right) ; 


procedure  Is_Less_Than 


(Left 

Right 

Result 


begin 

result  :=  Is_Less_Than 
end  Is_Less_Than; 


(Left, Right) ; 


procedure  Is_Less_Than  (Left 
Right 


in  String; 
in  String; 
out  Boolean)  is 


in  Substring; 
in  String; 
out  Boolean)  is 


in  String; 
in  Substring; 
out  Booleein)  is 


in  String; 
in  String; 
out  Boolean)  is 


in  Substring; 
in  String; 
out  Boolean)  is 


in  String; 
in  Substring; 


Result 

begin 

result  :=  Is_Less_Than  (Left, Right ) ; 

end  Is_Less_Than; 

procedure  Is__Greater_Than  (Left 
Right 
Result 

begin 

result  :=  Is_Greater_Than  (Left, Right) ; 
end  Is_Greater_Than; 

procedure  Is_Greater_Than  (Left 
Right 
Result 

begin 

result  :=  ls_Greater_Than  (Left, Right) ; 
end  Is_Greater„Than; 


:  out  Boolean)  is 


:  in  String; 

:  in  String; 

:  out  Boolean)  is 


;  in  Substring; 

:  in  String; 

:  out  Boolean)  is 


procedure  Is_Greater_Than 


(Left 

Right 

Result 


begin 

result  :=:  Is_Greater_Than  (Left, Right); 


Tc?  'rVian  •• 


procedure  Length_Of 
begin 

result  :=  Length_Of 
end  LengtlL_Of; 

procedure  Is_Null 

begin 

result  :=  Is_Null 
end  Isjaull; 


(The_String 

Result 

(The_String) ; 


(The_String 

Result 

{The_String) ; 


in  String; 
in  Substring; 
out  Boolean)  is 


in  String; 
out  Natural )  is 


in  String; 
out  Boolean)  is 


procedure  ItenuOf 


begin 

result  : =  ltem_Of 
end  Iteitt.Of; 


(The_String 

At_The_Position 

Result 


:  in  String; 

;  in  Positive; 
:  out  Item)  is 


(The_String,At_The_Position) ; 


procedure  Substring_Of  (The_String 
Result 


begin 

result  Substring_Of 
end  Substring_Of ; 


(The_String) ; 


in  String; 

out  Substring)  is 


procedure  S\jbstring_Of  (The_String  :  in  String; 

Froin_The_Position  :  in  Positive; 
To_The_Position  :  in  Positive; 
Result  :  out  Substring)  is 

begin 

result  :=  .  .  « 

Substring_Of  (The^String, From_The_Position,  To_The_Position) ; 
end  Substring_Of ; 


end  of  modification 


function  Is_Equal  (Left  :  in  String; 

Right  :  in  String)  return  Boolean  is 

begin 

if  Left.The_Length  /=  Right . The_Length  then 
return  False ; 

else 

for  Index  in  1  - .  Left .The_Length  loop 

if  Left  .The_Items  (Index)  /»  Right.  The_I  terns  (Index) 


then 


return  False; 
end  if; 
end  loop; 
return  True; 
end  if; 
end  Is^Equal; 


function  Is^Egual  (Left  :  in  Substring; 

Right  :  in  String)  return  Boolean  is 

begin 

if  Left 'Length  /=  Right . The_Length  then 


else 

for  Index  in  1  . .  Left 'Length  loop 

if  Left (Left 'First  +  Index  -  1)  /= 
Right . The_I terns ( Index )  then 

return  False; 
end  if; 
end  loop; 
return  True; 
end  if; 
end  Is_Equal; 


function  Is_Equal  (Left  :  in  String; 

Right  :  in  Substring)  return  Boolean  is 

begin 

if  Left.The^Length  /=  Right 'Length  then 
return  False; 

else 

for  Index  in  1  . .  Lef t .The_Length  loop 

if  Lef t.The_Items (Index)  /=  Right (Right 'First  +  Index 


“  1)  then 


return  False; 
end  if; 
end  loop; 
return  True; 
end  if; 
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end  Is_Egual; 

fimction  Is_Less_Than  (Left  ;  in  String; 

Right  :  in  String)  return  Boolean  is 

begin 

for  Index  in  1  . .  Left.The_Length  loop 
if  Index  >  Right. The_Length  then 
return  False; 

elsif  Left  .The_I terns  (Index)  <  Right  .The_I terns  (Index)  then 
return  True; 

elsif  Right , The_I terns  ( Index)  <  Left . The_Iteins  ( Index)  then 
return  False; 
end  if; 
end  loop; 

re  turn  (Left. The_Leng th  <  Right . The_Leng th ) ; 
end  Is_Less_Than; 

function  Is_Less_Than  (Left  :  in  Substring; 

Right  :  in  String)  return  Boolean  is 

begin 

for  Index  in  1  . .  Left 'Length  loop 
if  Index  >  Right. The_Length  then 
return  False; 

elsif  Left (Left 'First  +  Index  -  1)  < 

Right . The_I terns ( Index )  then 
return  True; 

elsif  Right .The_I terns (Index)  <  Left (Left 'First  +  Index  - 

1)  then 

return  False; 
end  if; 
end  loop; 

return  (Left 'Length  <  Right - The_Length) ; 
end  Is_Less_Than ; 


function  Is_Less_Than  (Left  :  in  Stringi- 

Right  :  in  Sxibstring)  return  Boolean  is 

begin 

for  Index  in  1  . .  Left .The_Length  loop 
if  Index  >  Right 'Length  then 
return  False; 

elsif  Left .The_I terns (Index)  <  Right (Right 'First  +  Index  - 

1)  then 

return  True; 

elsif  Right  (Right '  First  Index  -  1)  < 

Left. The_I terns ( Index )  then 

return  False; 
end  if; 
end  loopi- 

return  (Left .The_Length  <  Right 'Length) ; 
end  Is_Less_Than; 

function  Is_Greater_Than  (Left  :  in  Stringi- 

Right  :  in  String)  return  Boolean  is 

begin 

for  Index  in  1  ..  Left .The_Length  loop 
if  Index  >  Right, The_Length  then 
return  True; 

elsif  Left.The^I terns  (Index)  <  Right  .The_It ems  (Index)  then 
return  False; 

elsif  Right  .The_I terns  (Index)  <  Left  .The^Items  (Index)  then 
return  True ; 
end  if; 
end  loop; 
return  False; 
end  Is_Greater_Thani- 

function  Is_Greater_.Than  (Left  :  in  Substring; 

Right  ;  in  String)  return  Boolean  is 

begin 

for  Index  in  1  . .  Left 'Length  loop 
if  Index  >  Right . The_Length  then 
return  True; 


elsif  Left  (Left ‘First  -v  Index  -  1)  < 

Right. The_I terns ( Index )  then 
return  False; 

elsif  Right.  The_I  terns  (Index)  <  Left  (Left 'First  Index  - 

1)  then 

return  True; 
end  if; 
end  loop; 
return  False; 
end  Is_Gr eater _Than; 

function  Is_Greater_Than  (Left  ;  in  String; 

Right  ;  in  Substring)  return  Boolean  is 

begin 

for  Index  in  1  . .  Left.The_Length  loop 
if  Index  >  Right 'Length  then 
return  True; 

elsif  Left  .The_Iteins  (Index)  <  Right  (Right 'First  +  Index  - 

1 )  then 

return  False; 

elsif  Right  (Right 'First  Index  -  1)  < 

Left.  The_I  terns  ( Index )  then 
return  True; 
end  if; 
end  loop; 
retum  False; 
end  Is_Greater_Than; 

function  Length_Of  (The_String  :  in  String)  return  Natural  is 
begin 

return  The^Str ing . The JLength ; 
end  Length_Of; 

ftinction  Is_Null  (The_String  :  in  String)  return  Boolean  is 
begin 

return  (The_String.The_Length  =  0) ; 
end  Is_Null; 

function  IteituOf  (The_String  :  in  String; 

At_The_Position  :  in  Positive)  return  Item  is 

begin 

if  Atjrhe_Position  >  The_String.The_Length  then 
raise  Position^Error; 

else 

return  The_String.The_Items (At_The_Position) ; 
end  if; 
end  Iteir\_Of; 

function  S\jbstring_Of  (The_String  ;  in  String)  return  Substring  is 
Tenporary_Structure  :  Substring (1  ..  1) ; 
begin 

return  The_String . The^Items ( 1  ..  The_String.The_Length) ; 
exception 

when  Constraint_Error  => 

return  Tenporary_Structure(l  ..  0); 
end  Substring^Of ; 

f\mction  Substring_Of  (The_String  :  in  String; 

Fronv_The_Position  ;  in  Positive; 

To_The_Position  :  in  Positive)  return 

Substring  is 
begin 

if  (From_The_Position  >  The_String.The_Length)  or  else 
(To_The_Position  >  The_String.The_Length)  or  else 
(Fronijrhe__Position  >  To_The_Position)  then 
raise  Position^Error ; 

else 

return  The_S  tring.The_I  terns  (Froin_The_Pos  it  ion 
To_The_Position) ; 
end  if; 

end  Substring_Of ; 


end  String_Seguential_Unbounded«.UninanagedJJoniterator ; 


STRING  SEQUENTIAL  UNBOUNDED  UNMANAGED  NONITERATOR 


PSDL 


TYPE  string__Secjuential_UnboundedLUnmanaged_Noniterator 

SPECIFICATION 

GENERIC 

Item  :  PRIVATE_TyPE,  ,  . 

Substring  :  ARRAYIARRAY.ELEMENT  :  Item,  ARRAY^INDEX  :  Positive], 
func_''<*'  :  FUNCTION  [Left  :  Item,  Right  :  Item,  RETURN  :  Boolean] 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

FroirL_The_String  :  String, 

To_The_String  :  String 
OUTPUT 

To_The„String  :  String 
EXCEPTIONS 

Overflow,  Position^Error 

END 

OPERATOR  Copy 
SPECIFICATION 
INPUT 

From_The_Substring  :  Substring, 

To_The_String  :  String 
OUTPUT 

To_The_String  :  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_String  :  String 
OUTPUT 

The_String  :  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Prepend 
SPECIFICATION 
INPUT 

The_String  ;  String, 

To_The_String  :  String 
OUTPUT 

To_The_String  :  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Prepend 
SPECIFICATION 
INPUT 

The_Substring  :  Substring, 

To_The_String  :  String 
OXJTPUT 

To_The_String  :  String 
EXCEPTIONS 

Overflow,  Position^Error 

END 

OPERATOR  Append 
SPECIFICATION 
INPUT 

The_String  :  String, 

To_The_String  :  String 
OUTPUT 

To_The_String  :  String 
EXCEPTIONS 

Overflow,  Position^Error 

END 

OPERATOR  Append 
SPECIFICATION 
INPUT 

The^Substring  :  Substring, 

To_The_String  ;  String 
OUTPUT 

To_The_String  :  String 
EXCEPTIONS 

Overflow,  Posit ion_Error 

END 

OPERATOR  Insert 
SPECIFICATION 
INPUT 

The_String  ;  String, 

In_The_String  :  String, 

At_The_Position  :  Positive 
OUTPUT 

In_The_String  ;  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Insert 
SPECIFICATION 
INPUT 

The^Siibstring  :  Substring, 

In_The_String  :  String, 


At_The_Position  :  Positive 
OUTPUT 

In_The_String  :  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Delete 

SPECIFICATION 

INPUT 

In_The_String  :  String, 

From_The_Position  :  Positive, 

To_The_Position  :  Positive 
OUTPUT 

In_The_String  ;  String 
EXCEPTIONS 

Overflow,  Positioa-Error 

END 

OPERATOR  Replace 

SPECIFICATION 

INPUT 

In_The_String  :  String, 

At_The_Position  :  Positive, 

With_The_String  ;  String 
OUTPUT 

In_The_String  :  String 
EXCEPTIONS 

Overflow,  Position^Error 

END 

OPERATOR  Replace 

SPECIFICATION 

INPUT 

In_The_String  :  String, 

At_The_Position  :  Positive, 

With_The_Substring  :  Substring 
OUTPUT 

In_The_String  :  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 


OPERATOR  Set_Item 
SPECIFICATION 
INPUT 

In_The_String  :  String, 
At_The_Position  :  Positive, 
With_The_Item  :  Item 
OUTPUT 

InL_The_String  ;  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 


OPERATOR  Is_Equal 

SPECIFICATION 

INPUT 

Left  :  String, 

Right  :  String 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Is_Equal 

SPECIFICATION 

INPUT 

Left  :  Sxibstring, 

Right  :  String 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Position_Error 

END 


OPERATOR  ls_E<3ual 

SPECIFICATION 

INPUT 

Left  :  String, 

Right  :  Substring 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Is_Less_Than 

SPECIFICATION 

INPUT 

Left  :  String, 

Right  :  String 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Position^Error 

END 
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OPERATOR  Is_Less_Thaji 

SPECIFICATION 

INPUT 

Left  :  Substring, 

Right  ;  String 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Posit ion_Error 

END 

OPERATOR  Is_Less_Than 

SPECIFICATION 

INPUT 

Left  :  String, 

Right  :  Siibstring 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  PositionL.Error 

END 

OPERATOR  Is_Greater_Than 

SPECIFICATION 

INPUT 

Left  :  String, 

Right  :  String 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Is_Greater_Than 

SPECIFICATION 

INPUT 

Left  :  S\ibstring, 

Right  :  String 
OUTPUT 

Result  ;  Boolean 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Is_Greater_Than 

SPECIFICATION 

INPUT 

Left  :  String, 

Right  :  Stjbstring 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Length_Of 


SPECIFICATION 

INPUT 

The_String  :  String 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Position^Error 

END 

OPERATOR  ISjIull 

SPECIFICATION 

INPUT 

The_String  :  String 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  ItenuOf 

SPECIFICATION 

INPUT 

The_String  :  String , 

At_The_Position  ;  Positive 
OUTPUT 

Result  :  Item 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Substring_Of 

SPECIFICATION 

INPUT 

The_String  ;  String 
OUTPUT 

Result  :  Substring 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Substring_Of 

SPECIFICATION 

INPUT 

The_String  :  String , 

FroiiL.The_Position  :  Positive, 

To_The_Position  :  Positive 
OUTPUT 

Result  :  Substring 
EXCEPTIONS 

Overflow,  Posit ion_Error 

END 

END 

IMPLEMENTATION  ADA  String_Seguential_UnboundecLUninanage<2LNoniterator 
END 
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STRING  SEQUENTIAL  UNBOUNDED  UNMANAGED  ITERATOR 
ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

type  Sxjbstring  is  array  (Positive  range  <>)  of  Item; 
with  function  "<"  {Left  :  in  Item; 

Right  :  in  Item)  return  Boolean; 

package  string_Sequential_UnboundecLUnmanaged_Iterator  is 


type  String  is  limited  private; 


procedure  Copy 

procedure  Copy 

procedure  Clear 
procedure  Prepend 

procedure  Prepend 

procedure  Append 

procedure  Append 

procedure  Insert 

procedure  Insert 

procedure  Delete 

procedure  Replace 

procedure  Replace 

procedure  Set^ltem 


( From_The_S t r ing 
To_The_String 
( Fr om_The_Subs  t r ing 
To_The_String 
(The_String 
{The_String 
To_The_S  t r ing 
{ The_S\ibs  t  r  ing 
To JThe^S  t  r  ing 
{The_String 
To_The_String 
( The^Subs  tr  ing 
To_The_S  tr  ing 
(The_String 
In_The_String 
At_The_Posi tion 
{ The^Stibs  tr  ing 
In_The_String 
At_The_Position 
{ In_The_S tr ing 
Fr  onL.The_Pos  i  t  ion 
To_The_Pos i t i  on 
{In_The_String 
At_The_Position 
Wi th_The_S tr ing 
(In_The„String 
At_The_Position 
With_The_Substring 
( In_The_String 
A t_The_Pos i t ion 
With_The_Item 


in 

string; 

in 

out 

String) ; 

in 

Substring; 

in 

out 

String) ; 

in 

out 

String) ; 

in 

String; 

in 

out 

String) ; 

in 

Sxjbstring; 

in 

out 

String) ; 

in 

String; 

in 

out 

String) ; 

in 

Substring; 

in 

out 

String) ; 

in 

String; 

in 

out 

Stringi- 

in 

Positive)  ; 

in 

Sxibstring; 

in 

out 

String; 

in 

Positive) ; 

in 

out 

String; 

in 

Positive; 

in 

Positive) ; 

in 

out 

String; 

in 

Positive; 

in 

String) ; 

in 

out 

String; 

in 

Positive; 

in 

Substring) 

in 

out 

String; 

in 

Positive; 

in 

Item) ; 

—  modified  by  Vincent  Hong  and  Tuan  Nguyen 

—  date:  9  April  199S 

—  adding  procedures  to  replace  functions 


procedure  Is^Equal  (Left 

Right 
Result 

procedure  Is^Equal  (Left 

Right 
Result 

procedure  Is^Ecjual  (Left 

Right 
Result 

procedure  Is_Less_Than  (Left 

Right 
Result 

procedure  Is_Less_Thcin  (Left 

Right 
Result 

procedure  Is_Less_Than  (Left 

Right 
Result 


procedure  Is_Greater_Than  (Left 
Right 
Result 

procedure  Is_Greater_Than  (Left 
Right 
Result 

procedure  Is_Greater_Than  (Left 
Right 
Result 


in  String; 
in  String; 
out  Boolean) ; 
in  Substring; 
in  String; 
out  Boolean) ; 
in  String; 
in  Substring; 
out  Boolean) ; 
in  String; 
in  String; 
out  Boolean) ; 
in  Substring; 
in  String; 
out  Boolean) ; 
in  String; 
in  Substring; 
out  Boolean) ; 
in  String; 
in  String; 
out  Boolean) ; 
in  Substring; 
in  String; 
out  Boolean) ; 
in  String; 
in  Substring; 
out  Boolean) ; 


procedure  Length_0f 

(The_String 

in  String ; 

Result 

out  Natural) ; 

procedure  IsJIull 

(The_String 

in  String; 

Result 

out  Boolean) ; 

procedure  IteituOf 

(The_String 

in  String; 

At_The_Position 

in  Positive; 

Result 

out  Item)  ; 

procedure  Substring_Of 

(The_String 

in  String; 

Result 

out  Substring) ; 

procedure  Siibstring_Of 

(The_String 

in  String; 

Fr  ortL_The_Pos  i  t  ion 

in  Positive; 

To_The_Position 

in  Positive; 

—  end  of  modification 

Result 

out  Substring) ; 

function  Is_Equal 

(Left  : 

in  String; 

Right  : 

in  String)  return 

Boolean; 

in  Substring; 

function  Is_Equal 

(Left  : 

Right  : 

in  String)  return 

Boolean; 

in  String ; 

fxinction  Is_Equal 

(Left  : 

Right  : 

in  Stibstring)  return 

Boolean; 

in  String; 

function  Is_,Less_Than 

(Left  : 

Boolean; 

Right  : 

in  String)  return 

function  Is_Less_Than 

(Left  : 

in  Slabs  tring; 

Right  : 

in  String)  return 

Boolean; 

in  String; 

fxjnction  Is_Less_Than 

(Left  : 

Right  : 

in  Substring)  return 

Boolean; 

in  String; 

function  ls_Greater_Than 

(Left  : 

Right  : 

in  String)  return 

Boolean; 

in  Substring; 

function  Is_Greater_Than 

(Left  : 

Right  : 

in  String)  return 

Boolean; 

in  String; 

function  Is„Greater_Than 

(Left  : 

Boolean; 

Right  : 

in  Substring)  return 

function  Length_Of 
Natural; 

(The_String  : 

in  String)  return 

function  Is_Null 

(The_String  : 

in  String)  return 

Boolean; 

in  String ; 

fianction  Item_Of 

(The_String  : 

At_The_Position  : 

in  Positive)  return 

I  tern; 

function  Substring^Of 

{The_String  : 

in  String)  return 

Svibstring; 

in  String; 

function  Substring_Of 

(The_String  : 

From_The_Position  : 

in  Positive; 

To^The_Position  : 

in  Positive) return 

Substring; 


generic 

with  procedure  Process  (The_Item  :  in  Item; 

Continue  :  out  Boolean) ; 

procedure  Iterate  (Over_The_String  :  in  String) ; 

Overflow  :  exception; 

Position_Error  :  exception; 

private 

type  Structure  is  access  Substring; 
type  String  is 
record 

'Ihe_Length  :  Natural  ;=  0; 

The_Iteins  :  Structure; 
end  record; 

end  String_Sequential_Unbounded_Uninanaged_Iterator ; 
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STRING  SEQUENTIAL  UNBOUNDED  UNMANAGED  ITERATOR 
ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Nxuober  0100219 

■Restricted  Rights  Legend* 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  eind  Con^uter 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

package  body  String_Sequential_Unbounded_UninanagecLIterator  is 

procedure  Set  (The_String  :  in  out  String; 

To_The_Size  ;  in  Natural; 

Preserve_The_Value  :  in  Boolean)  is 

Ten?>orary_Structure  :  Structure; 
begin 

if  To_The_Size  =  0  then 

The_String.The_I terns  :=  null; 
elsif  The_String.The_Items  «  null  then 

The_String.The„I terns  :=  new  Substring (1  ..  To_The_Size)  ; 
elsif  To_The_Size  >  The_String.The_I terns 'Length  then 
if  Preserve_The_Value  then 

Teinporary_Structure  new  Substring  1 1  .. 

To_The_Size) ; 

Temporary_Structure{l  ..  The_String.The_Length)  := 
The_S tring . The_I terns (1  . .  The_S tr ing , The_Length ) ; 
The_String.The_I terns  Teitporary_Structure; 

else 

The_String.The„Iteins  :=  new  Substring (1  .. 

To_The_Size) ; 

end  if; 
end  if; 

The_S  t r ing . The_Leng th  : =  To_The_Si z e ; 
end  Set; 

procedure  Copy  (Froin_The_S tring  :  in  String; 

To_The_S tring  ;  in  out  String)  is 

begin 

Set {To_The_S tring , 

To_The_Size  =>  FrortL.The_String.The_Length, 

Preserve_The_Value  =>  False); 

To_The_String. The_I terns (1  Froin_The_String.The_Length)  ;  = 

FroitL_The_String . The_I terns  (1  . .  FrortuThe_String . The^Length)  ; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Copy; 

procedure  Copy  (From_The_Siibs tring  :  in  Substring; 

To_The_String  :  in  out  String)  is 

begin 

Se  t { To_The_S tr ing , 

To_The_Size  =>  Froin_The_Substring' Length, 

Preserve_The_Value  =>  False) ; 

To_The_Str ing .  The_I  tems  (1  - .  Fr oiiL_The_Subs  tring  •  Leng  th )  :  = 
FronL.The— Substring ; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Copy; 

procedure  Clear  {The_S tring  ; 
begin 

Set (The_S tring, 

To_The_Size  => 

Preseirvejrhe_Value  => 
end  Clear; 

procedure  Prepend  (The_S tring  :  in  String; 

To_The_String  ;  in  out  String)  is 
01d_Length  :  Natural  :=  To_The_S tring. The_Length; 

New^Length  :  Natural  := 

To_The_S tring . The_Leng th  +  The_S tring . The_Length ; 

begin 

Se  t ( To_The_S tring , 

To_The_Size  ->  New_Length, 

Preserve_The_Value  =>  True) ; 

TojThe._String.The_Items(  (The_S tring. The_Length  +  1)  .. 

New_Length) 

:=  To_The_String. The_I terns (1  ..  01d_Length) ; 

To_The_S  tring . The_I t ems (1  , .  The_S tring , The_Length )  :  = 

The_S  tring .  The_Iteins  (1  . .  The_Str  ing .  TheJLength )  ; 
exception 

when  Storage_Error  ==> 
raise  Overflow; 
end  Prepend; 

procedure  Prepend  ( The_Subs tring  :  in  Substring; 

To_The_String  :  in  out  String)  is 
OldLLength  :  Natural  :=  To_The_String.The_Length; 

New_Length  :  Natural  ;= 

To_The_String,The_Length  +  The_Substring’ Length ; 

begin 

Set (To_The_S tring. 


To_The_Size  =>  New_Length, 

Preserve_The_Value  =>  True) ; 

To_The_String .  The_Iteins  ( (The_Subs tring '  Length  +  1 )  . . 
New_Length) 

:=  To_The_String.The_Itenis(l  ..  01d__Length)  ; 

To_The_String . The_I tems (1  . .  The_Substring ‘ Length)  : = 

The_Subs  tring ; 
exception 

when  Storage_,Error  => 
raise  Overflow; 
end  Prepend; 

procedure  Append  (The_S tring  :  in  String; 

To_The_S tring  :  in  out  String)  is 
01d_Length  :  Natural  :=  To_The_String,The_Length; 

NewJLength  :  Natural  := 

To_The_String .  The_Length  +  The^Str  ing .  The_Length; 

begin 

Set ( To_The_S tring , 

To_The_Size  =>  New_Length, 

Preserve_The_Value  =>  True) ; 

To„The_String.The_Items(  (OldLLength  +1)  ..  New_Length) 

: =  The_S tring . The_l tems (1  . .  The_S t r ing . The_Leng th ) ; 
exception 

when  Storage_Error  =:> 
raise  Overflow; 
end  impend; 

procedure  Aj^end  (The_Subs tring  :  in  Substring; 

To_The_String  :  in  out  String)  is 
Old_Length  :  Natural  ;=  To_The_String.The_Length; 

New_Length  :  Natural  := 

To^The_S  tring .  The_Leng  th  +  The_Subs  tring  ’  Length ; 

begin 

Set (To_The_String , 

To_The_Size  =>  New_Length, 

Preserve_The_Value  *>  True) ; 

To_The_S tr ing. The_I tems { (01d_Length  +1)  ..  New_Length) 

;=  The_Svibs  tring; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Append; 

procedure  Insert  (The_String  :  in  String; 

In_The_S tring  :  in  out  String; 

At_The_Position  :  in  Positive)  is 

OlcLLength  :  Natural  :=  In_The_String.The_Length; 

New_Length  ;  Natural  : = 

In_The_String.The_Length  + 

The_Str ing . The_Length ; 

End_Position  :  Natural  ;= 

At_The_Position  +  The_S tring. The_Length; 

begin 

if  At_The_Position  >  In_The_String.The_Length  then 
raise  Position_Error; 

else 

Set { In_The_String , 

To_The_Size  =>  New_Length, 

Preserve_TheJValue  =>  True) ; 

In_The_S tring. The_I tems (End^Position  ..  New_Length)  := 
ln_The_String.The_Items{At_The_Position  ..  Old^Length) ; 
In_The__String.The_Items  (At_The_Position  ..  (End_Position  - 

D)  :  = 

The_S  tring .  The_I  t ems  (1  . .  The_S  tring .  The_Leng th )  ; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Insert; 

procedure  Insert  (The_Subs tring  :  in  Substring; 

In_The_S tring  :  in  out  String; 

At_The_Position  :  in  Positive)  is 
01d_Length  :  Natural  :=  In_The_String.The_Length; 

New_Length  :  Natural  := 

In_The_String.The_Length  + 

The_Subs tring ' Length; 

End_Position  :  Natural  := 

At_The_Position  +  The_S\ibs tring ‘Length; 

begin 

if  At_The_Position  >  In_The_String.The_Length  then 
raise  Position_Error ; 

else 

Se  t  { In_The_S  tring , 

To_The_Size  =>  New__Length, 

Preserve_The_Value  =>  True) ; 

In_The_String.The_Items  (End_Position  ..  New_Length)  :  = 
In_The_String.The_Items(At_The_Position  ..  01d_Length)  ; 
In  The_String.The^Iteins (At_The_Position  ..  (End_Position  - 

D)  :  = 

The_Subs  tring  ; 
end  if; 
exception 

when  Storage_Error  => 
raise  Overflow; 
end  Insert; 

procedure  Delete  (In_The_S tring  :  in  out  String; 


in  out  String)  is 
0, 

False) ; 
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FroitL.The_Position  :  in  Positive; 

To_The_Position  :  in  Positive)  is 

New_Length  :  Natural; 
begin 

if  (FronuThe^Position  >  In_The_String.The_Length)  or  else 
(To_The_Position  >  In_The_String.The_Length)  or  else 
(FroituThe_Position  >  To_The„Position)  then 
raise  Position_Error ; 

else 

New_Length  ;=  In_The_String,The_Length  - 

(To_The„Position  -  Froin_The_Position  +  1)  ; 
In_The_S t  r  ing .  The_I  t envs  ( Fr onuThe_Pos  i  t ion  . .  New_Leng t h ) 

In__The_String .  The_Iteins 

( (To_The_Position  +  1)  ..  In_The_String.The_Length) ; 

Set ( In_The_String, 

To_The_Size  =>  New_Length, 

Preserve_The_Value  =>  True); 

end  if; 
end  Delete; 


procedure  Replace  (In_The_String  :  in  out  String; 

At_The_Position  :  in  Positive; 

With_The_String  :  in  String)  is 

End^Position  :  Natural 

At_The_Position  +  With_The_String.The_Length  - 

1; 

begin 

if  (At_The_Position  >  In-.The_String.The_Length)  or  else 
(EndLPosition  >  In^The_String.The_Length)  then 
raise  Position_Error; 

In_The_String.The_Items(At_The_Position  ..  End_Position) 

Wi  th_The_Str  ing .  The_I  terns  (1  , . 

Wi th_The_S t r ing . The_Leng th ) ; 
end  if; 
end  Replace; 


procedure  Replace  (In_The_String 

At_The_Posi tion 
Wi th_The_Subs  tr ing 
End_Position  :  Natural  :=  .  , 

At_The_Position  +  With_The_Substring' Length  -- 


in  out  String; 
in  Positive; 

in  Substring)  is 


begin  .  ^  . 

if  (At_The_Position  >  In_The_String.The_Length)  or  else 
(End_Position  >  In_The_String.The_Length)  then 
raise  Position_Error; 

In_,The_S  tr  ing.  The_I  terns  (At_The_Position  ..  End^_Position) 

Wi th_The_Subs  tring ; 
end  if; 
end  Replace; 

procedure  Set_Itein  (In_The_S tring  :  in  out  String; 

At_The_Position  :  in  Positive; 

With^The_Item  :  in  Item)  is 

begin 

if  At_The_Position  >  In_The_String .The_Length  then 
raise  Position_Error; 

In_The_S  tr  ing.  The_I  terns  {At_The_Position)  :=  With_The_Item; 

end  if; 
end  Set_Item; 


—  modified  by  Vincent  Hong  and  Tuan  Nguyen 

—  date:  9  April  1995 

adding  procedures  to  replace  functions 


procedure  Is^Equal 


begin 

result  :=  Is^Equal 
end  Is_Egual; 


{Left 

Right 

Result 

(Left, Right) ; 


procedure  Is_Equal 


begin 

result  :=  Is_Equal 
end  Is_Equal; 


{Left 

Right 

Result 

(Left, Right) ; 


procedure  Is_Equal 


begin 

result  :=  Is^Egual 
end  Is_Equal; 


(Left 

Right 

Result 

(Left, Right) ; 


procedure  Is„Less_Than 


(Left 

Right 

Result 


begin 

result  : =  Is_Less_Than 
end  Is_Less_Than; 


(Left, Right) ; 


procedure  Is_Less_Than 


(Left 

Right 

Result 


begin 

result  Is_Less_Than 
end  Is_Less_Than; 


(Left, Right) ; 


procedure  Is_Less_Thaun  (Left 
Right 


in  String; 
in  String; 
out  Boolean)  is 


in  Substring; 
in  String; 
out  Boolean)  is 


in  String; 
in  Substring; 
out  Boolean)  is 


in  String; 
in  String; 
out  Boolean)  is 


in  Substring; 
in  String; 
out  Boolean)  is 


in  String; 
in  Sxabs tring; 


Result 

begin 

result  :=  Is_Less_Than  (Left, Right) ; 
end  Is_Less_Than; 

procedure  Is_Greater_Than  (Left 
Right 
Result 

begin 

result  :=  Is_Greater_Than  (Left, Right) ; 
end  Is_Greater_Than; 

procedure  Is_Greater_Than  (Left 
Right 
Result 

begin 

result  ;=  Is_Greater_Than  (Left, Right ) ; 
end  Is_Greater_Than; 


out  Boolean)  is 


in  String; 
in  String ; 
out  Boolean)  is 


in  Substring; 
in  String; 
out  Booleein)  is 


procedure  Is_Greater_Than 


(Left 

Right 

Result 


begin 

result  :=  Is„Greater_Than 
end  Is^GreaterJThan; 


(Left, Right) ; 


procedure  Length_Of 
begin 

result  :=  Length_Of 
end  Length_Of; 


(The_S tring 
Result 

(The^String) ; 


procedure  Is^ull  (The_S tring 

Result 

begin 

result  Is_Null  {The_String) ; 

end  Is_Null; 


in  String; 
in  Substring; 
out  Boolean)  is 


in  String; 
out  Natural)  is 


in  String; 
out  Boolean)  is 


procedure  ItenuOf 


begin 

result  ;=  ItenuOf 
end  ItenuOf; 


(The_S tring 
At_The_Posi tion 
Result 


:  in  String; 

:  in  Positive; 
:  out  Item)  is 


(The_String,At_The_Position) ; 


procedure  Substring_Of  (The_S tring 

Result 


begin 

result  :=  SvLbstring_Of 
end  Substring_Of ; 


(The_S tring)  ; 


in  String; 

out  S\ibstring)  is 


procedure  Substring_Of  (The_S tring  :  in  String; 

FronuThe_Position  :  in  Positive; 
To_The_Position  :  in  Positive; 
Result  :  out  Siibstring)  is 

begin 

result  :=  .  •  V 

Substring_Of  (The_String, FronuThe_Position, To_The_Position)  ; 

end  Substring_Of ; 


—  end  of  modification 

fvinction  Is.Egual  (Left  ;  in  String; 

Right  :  in  String)  return  Boolean  is 

begin 

if  Left .The_Length  /=  Right . The_Length  then 
return  False; 

else 

for  Index  in  1  . .  Left.The_Length  loop 

if  Left.The_I  terns  (Index)  /=  Right  .The_I  terns  (Index) 


return  False; 
end  if; 
end  loop; 
return  True; 
end  if; 
end  Is_Equal ; 

function  Is_Equal  (Left  :  in  Substring; 

Right  :  in  String)  return  Boolean  is 

begin 

if  Left 'Length  /=  Right .The_Length  then 
return  False; 

else 

for  Index  in  1  . .  Left 'Length  loop 

if  Left (Left 'First  +  Index  -  1)  /= 

Right . The_I terns ( Index )  then 

return  False; 
end  if; 
end  loop; 
return  True; 
end  if; 
end  Is_Equal; 

function  Is_Equal  (Left  :  in  String; 

Right  :  in  SxdDS tring)  return  Boolean  is 

begin 

if  Left.The_Length  {-  Right 'Length  then 
return  False; 

else 

for  Index  in  1  . .  Lef t .The_Length  loop  ^ 

if  Left .The_I terns (Index)  /=  Right (Right 'First  +  Index 

-  1)  then 

return  False; 
end  if; 
end  loop; 
retujm  True; 
end  if; 
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end  Is_Equal; 

function  Is_JLess_Than  (Left  :  in  String; 

Right  :  in  String)  return  Boolean  is 

begin 

for  Index  in  1  . .  Left,The_Length  loop 
if  Index  >  Right . The_Length  then 
return  False; 

eisif  Left.The_I  terns  (Index)  <  Right.The_I  terns  (Index)  then 
return  True; 

eisif  Right  .The_It  ems  (Index)  <  Left.The_I  terns  (Index)  then 
return  False; 
end  if; 
end  loop; 

return  (Left. The^Leng th  <  Right . The_Leng th ) ; 
end  Is_Less_Than; 

function  Is_Less_Than  (Left  ;  in  Substring; 

Right  :  in  String)  return  Boolean  is 

begin 

for  Index  in  1  . -  Left ’ Length  loop 
if  Index  >  Right .The_Length  then 
return  False; 

eisif  Left (Left ‘First  +  Index  -  1)  < 

Right . The_I terns { Index )  then 
return  True; 

eisif  Right  .The_I terns  (Index)  <  Left  (Left '  First  +  index  - 

1)  then 

return  False; 
end  if; 
end  loop; 

return  (Left 'Length  <  Right .The_Length) ; 
end  Is_Less_Than; 


function  ls_Less_Than  (Left  :  in  String; 

Right  :  in  Substring)  return  Boolean  is 

begin 

for  Index  in  1  . .  Left .The_Length  loop 
if  Index  >  Right 'Length  then 
return  False; 

eisif  Left.The_Items( Index)  <  Right (Right ‘First  +  Index  - 

1)  then 

return  True; 

eisif  Right (Right 'First  +  Index  -  1)  < 

Left.  The_I terns  ( Index )  then 

return  False; 
end  if; 
end  loop; 

return  (Lef t •The_Length  <  Right ' Length ) ; 
end  Is_Less_Than ; 


end  if; 
end  loop; 
return  False ; 
end  Is_Greater_Than; 

function  Is_Greater_Than  (Left  ;  in  String; 

Right  ;  in  Substring)  return  Boolean  is 

begin 

for  Index  in  1  . .  Left .The_Length  loop 
if  Index  >  Right ‘Length  then 
return  True; 

eisif  Lef t.The^Items (Index)  <  Right (Right ‘First  +  Index  - 

1)  then 

return  False; 

eisif  Right (Right ‘First  +  Index  -  1)  < 

Left.  The_I  terns  { Index )  then 
return  True; 
end  if; 
end  loop; 
return  False; 
end  Is_Greater_Than; 

function  Length_Of  (The_String  :  in  String)  return  Natural  is 
begin 

return  The_S  t r ing .  The_Leng  th  ; 
end  Length_Of; 

ftinction  IsJNull  (The_String  :  in  String)  return  Boolean  is 
begin 

return  (The_String.The_Length  =  0) ; 
end  Is_Null; 

fxinction  ItertuOf  (The_String  :  in  String; 

At_The_Position  ;  in  Positive)  return  Item  is 

begin 

if  At_The_Position  >  The_String.The_Length  then 
raise  Position_Error; 

else 

re  turn  The_S  t  r  ing .  The_I  terns  ( A  t_The_Pos  i  t  ion )  ; 
end  if; 
end  Iteii\_Of; 

function  Substring_Of  (Ihe^String  :  in  String)  return  Substring  is 
Temper ary_S true ture  :  Substring  (1  ..  1); 
begin 

return  The_S tr ing .  The_I terns  (1  , .  The_S tring .  The_Length) ; 
exception 

when  Cons train t_Error  => 

return  Tenporary_Structure(l  ..  0); 
end  S\jbstring_Of  ; 


function  Is_Greater_Than  (Left  :  in  String; 

Right  :  in  String)  return  Boolean  is 

begin 

for  Index  in  1  . ,  Left .The_Length  loop 
if  Index  >  Right . The_Length  then 
return  True; 

eisif  Lef  t.The_I  terns  (Index)  <  Right  .The_I  terns  (Index)  then 
return  False; 

eisif  Right  .The_I terns  (Index)  <  Lef  t.The_I terns  (Index)  then 
return  True; 
end  if; 
end  loop; 
return  False; 
end  ls_Greater_Than; 


function  Substring^Of  (The_String  :  in  String; 

FronuThe_Position  :  in  Positive; 

To_The_Position  :  in  Positive)  return 

Substring  is 
begin 

if  {Froit\_The_Position  >  The_String.The_Length)  or  else 
(To_The_Position  >  The_String.The_Length)  or  else 
(Froin_The_Position  >  To_The_Position)  then 
raise  Positior\_Error; 

else 

return  The_String.The_Iteins (FroitL.The_Position  .. 
To_The_Position) ; 
end  if; 

end  Substring^Of ; 


function  Is_Greater_Than  (Left  :  in  Substring; 

Right  :  in  String)  return  Boolean  is 

begin 

for  Index  in  1  . .  Left ‘Length  loop 
if  Index  >  Right . The^Length  then 
return  True; 

eisif  Left (Left 'First  +  Index  -  1)  < 

Right .  The_I terns  ( Index )  then 

return  False; 

eisif  Right  .The_I  terns  (Index)  <  Left  (Lef  t‘ First  +  Index  -- 

1 )  then 

return  True; 


procedure  Iterate  (Over_The_S tring  :  in  String)  is 
Continue  :  Boolean; 
begin 

for  The_Iterator  in  1  . .  Over_The_String.The_Length  loop 
Process  (Over_The_Str ing. The_I terns  (The_Iterator) , 

Continue) ; 

exit  when  not  Continue; 
end  loop; 
end  Iterate; 

end  String_Sequential_UnboundecLUnmanaged_I terator ; 
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STRING  SEQUENTIAL  UNBOUNDED  UNMANAGED  ITERATOR 

PSDL 


TYPE  string_Seguential_Unboimde<a_Uninanaged_Iterator 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TYPE,  .  . 

Sxabstring  :  ARRAY [ARRAY_ELEMENT  :  Item,  ARRAY_INDEX  :  Positive], 
£unc_“<"  :  FUNCTION  [Left  :  Item,  Right  :  Item,  RETURN  :  Boolean] 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

From_The_String  :  String, 

To_The_String  :  String 
OUTPUT 

To_The_String  :  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Copy 
SPECIFICATION 
INPUT 

From_The_Substring  :  Substring, 

To_The_String  :  String 
OUTPUT 

To_The_String  :  String 
EXCEPTIONS 

Overflow,  Posit ion_Error 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_String  :  String 
OUTPUT 

The^String  :  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Prepend 
SPECIFICATION 
INPUT 

The_String  :  String, 

To_The_String  :  String 
OUTPUT 

To_The_String  :  String 
EXCEPTIONS 

Overflow,  Posit ion_Error 

END 

OPERATOR  Prepend 
SPECIFICATION 
INPUT 

The^Substring  :  S\ibstring, 

To_The_String  :  String 
OUTPUT 

To_Tlie_String  :  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Append 
SPECIFICATION 
INPUT 

The^String  :  String, 

ToJThe^String  :  String 
OUTPUT 

To_The_String  :  String 
EXCEPTIONS 

Overflow,  Posit ion_Error 

END 

OPERATOR  Append 
SPECIFICATION 
INPUT 

The_Substring  :  Substring, 

To_The_String  :  String 
OUTPUT 

To_The_String  :  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 


OPERATOR  Insert 
SPECIFICATION 
INPUT 

The_String  :  String, 
In_The_String  :  String, 
At_The_Position  :  Positive 
OUTPUT 

In_The_String  ;  String 
EXCEPTIONS 

Overflow,  Position^Error 

END 

OPERATOR  Insert 
SPECIFICATION 
INPUT 

The_Substring  :  Substring, 
ln^The_String  :  String, 


At_The_Position  :  Positive 
OUTPUT 

In_The_String  :  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Delete 

SPECIFICATION 

INPUT 

In_The_String  :  String, 
FroirL_The_,Position  :  Positive, 
To_The_Position  :  Positive 
OUTPUT 

In_The_String  :  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Replace 

SPECIFICATION 

INPUT 

In_The_String  :  String, 
At_The_Position  :  Positive, 
With_The_String  ;  String 
OUTPUT 

In_The_String  :  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Replace 

SPECIFICATION 

input 

In_The_String  :  String, 
At_The_Position  :  Positive, 
With_The_Substring  :  Substring 
OUTPUT 

In_The_String  :  String 
EXCEPTIONS 

Overflow,  Position^Error 

END 

OPERATOR  Set_Item 

SPECIFICATION 

INPUT 

In_The_String  :  String, 
At_The_Position  :  Positive, 
With_The_Item  :  Item 
OUTPUT 

In_The_String  :  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Is^Equal 

SPECIFICATION 

INPUT 

Left  :  String, 

Right  :  String 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  IS_Equal 

SPECIFICATION 

INPUT 

Left  :  Substring, 

Right  :  String 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Position_Error 

END 


OPERATOR  Is_Equal 

SPECIFICATION 

INPUT 

Left  :  String, 

Right  :  Substring 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Is_Less_Than 

SPECIFICATION 

INPUT 

Left  ;  String, 

Right  :  String 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Position_Error 

END 
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OPERATOR  Is_Less_Than 

SPECIFICATION 

INPUT 

Left  :  Substring, 

Right  :  String 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Is_Less_Than 

SPECIFICATION 

INPUT 

Left  :  String, 

Right  :  Sxibstring 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Is_Greater_Than 

SPECIFICATION 

INPUT 

Left  :  String, 

Right  :  String 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Is_Greater_Than 

SPECIFICATION 

INPUT 

Left  :  S\ibstring, 

Right  :  String 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Is_Greater_Than 

SPECIFICATION 

INPUT 

Left  :  String, 

Right  ;  Substring 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Length_Of 

SPECIFICATION 

INPUT 

The_String  :  String 
OUTPUT 

Result  ;  Natural 


EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  IS_Null 

SPECIFICATION 

INPUT 

The_String  :  String 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  IteitL.Of 

SPECIFICATION 

INPUT 

The_String  :  String, 

At_The_Position  ;  Positive 
OUTPUT 

Result  :  Item 
EXCEPTIONS 

Overflow,  Positiort-Error 

END 

OPERATOR  Siabstring_Of 

SPECIFICATION 

INPUT 

The_String  ;  String 
OUTPUT 

Result  :  Substring 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Substring_„Of 

SPECIFICATION 

INPUT 

The^String  :  String, 

FronuThe_Position  :  Positive, 

To_The_Position  :  Positive 
OUTPUT 

Result  :  S\jbstring 
EXCEPTIONS 

Overflow,  Position_Error 

END 

OPERATOR  Iterate 

SPECIFICATION 

GENERIC 

Process  :  PROCEDURE  [The_Item  ;  in  It  :  Item],  Continue  ;  outtt 
Boolean] ] 

INPUT 

Over_The_String  ;  String 
EXCEPTIONS 

Overflow,  Position_Error 

END 

END 

IMPLEMENTATION  ADA  String_Sequential_Unbounded_Uninanage(a_Iterator 
END 
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TREE  ARBITRARY  DOUBLE  UNBOUNDED  MANAGED 


ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

ExpectedJJumber_Of_Children  :  in  Positive; 
package  Tree.J^bitrary_Double^Unbounded_Jlanaged  is 


type  Tree 

is  private 

Null_Tree 

:  constant 

Tree; 

procedure 

Copy 

{ From_The_Tree 

in 

Tree; 

To_The_Tree 

in 

out 

Tree) ; 

procedure 

Clear 

{The^Tree 

in 

out 

Tree) ; 

procedure 

Construct 

(The_Item 

in 

I  tern; 

And^The_Tree 

in 

out 

Tree; 

Number^Of _Chi Idr en 

in 

Natural; 

On^The_Child 

in 

Natural) 

procedure 

Set_Item 

{Of_The_Tree 

in 

out 

Tree; 

To_The_Item 

in 

Item)  ; 

procedure 

Swap^Child 

(The_Child 

in 

Positive 

Of_The_Tree 

in 

out 

Tree; 

And_The_Tree 

in 

out 

Tree) ; 

—  modified  by  Tuan  Nguyen 

—  25  December  1995 

—  adding  procedures  to  replace  functions 

procedure  Is_Equal  (Left 

Right 

Result 

procedure  Is_Null  (The^Tree 

Result 

procedure  ItenuOf  (The^Tree 

Result 


in  Tree; 
in  Tree; 
out  Boolean) ; 
in  Tree; 
out  Boolean) ; 
in  Tree) ; 
out  Item) ; 


procedure  Number _Of_Children_In  (The^Tree 

Result  . 

procedure  Child_Of  (The_Tree 

Ihe^Child 

Result 

end  of  modification 


:  in  Tree ; 

:  out  Natural) 
:  in  Tree; 

:  in  Positive; 

:  out  Tree ) ; 


function 

Booleeui; 

Is_Egual 

(Left 

Right 

in 

in 

Tree; 

Tree) 

function 

Boolean; 

ls_Null 

{The_Tree 

in 

Tree) 

fxinction 

Item; 

Item_Of 

(The_Tree 

in 

Tree) 

function 

Natural; 

Number_0  f  _Chi  ldren_In 

{The_Tree 

:  in 

Tree) 

function 

Tree; 

Child_Of 

{The_Tree 
The_Child  ; 

:  in 
;  in 

Tree; 

Positive) 

function 

Tree; 

Parent_Of 

{The_Tree 

!  in 

Tree) 

Overflow 
Tree_Is_Null 
Tr  ee_I  s_No  t  JMu  1 1 
Not^t_Root 
ChildLError 


exception; 

exception; 

exception; 

exception; 

exception; 


private 

type  Node; 

type  Tree  is  access  Node; 

Null_Tree  :  constant  Tree  :=  null; 
end  Tr ee_jArbi  t r ary_Double_Unbounded_Nanaged  ; 


return 

return 

return 

return 

return 

return 
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TREE  ABBITRARY DOUBLE  UNBOUNDED  MANAGED 


ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

■Restricted  Rights  Legend* 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Conputer 

—  Software  Clause  of  FAR  52 .227-7013 .  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

wi  th  Map_S  inpl  e JJoncached_Sequen t  ia  l_Unbounde<iJlanaged_I  tera t or , 
Storage_Manager_Sequential ; 

package  body  Tree_Arbitrary_Doiible_UnboundecLJManaged  is 

function  Hash_Of  (The_Child  :  in  Positive)  return  Positive; 
package  Children  is  new 

Map_Sinple_NoncachedLSequential_Unbo\indedJManaged_Iterator 
(Domain  =>  Positive, 

Ranges  =>  Tree , 

Number_Of_Buckets  =>  Expected_Nuinber_Of_^Children, 

Hash_Of  =>  Hash^Of ) ; 

type  Node  is 
record 

Previous  :  Tree ; 

The_Item  :  Item; 

The_Children  :  Children. Map; 

Next  :  Tree; 

end  record; 

function  Hash_Of  (The_Child  :  in  Positive)  return  Positive  is 
begin 

return  The_Child; 
end  Hash-Of; 

procedure  Free  (The_Node  ;  in  out  Node)  is 
begin 

The_Node . Previous  :=  null; 

Children. Clear (The_Node .The_Children) ; 
end  Free; 

procedure  Set_Next  (TheJJode  ;  in  out  Node; 

ToJ^Iext  :  in  Tree)  is 

begin 

TheJNode .  Next  :  =  To JtJext  ; 
end  Set_Next; 

function  Next_Of  (TheJMode  :  in  Node)  return  Tree  is 
begin 

return  The_Node.Next ; 
end  Next_Of ; 

package  NodeJManager  is  new  Storage_Manager_Sequential 

(Item  =>  Node, 

Pointer  =>  Tree, 

Free  =>  Free, 

Set^Pointer  =>  Set^ext, 
Pointer_Of  =>  Next_Of ) ; 

procedtore  Copy  ( From_The_Tree  :  in  Tree; 

To_The_Tree  :  in  out  Tree)  is 
procedure  Copy_Child  (The_Domain  :  in  Positive; 

The_Range  :  in  Tree; 

Continue  :  out  Boolean)  is 
Temporary  JNode  :  Tree ; 
begin 

Copy(The_Range,  To_The_Tree  =>  Teinporary_Node)  ; 

Children  -Bind  (The_Doinain,  Temporary^Node , 

In_TheJMap  =>  To_The„Tree  .The_Children)  ; 
if  Temporary^Node  /=  Null_Tree  then 

Temporary_JIode .  Previous  :  =  To^The_Tree ; 
end  if; 

Continue  : =  True ; 
end  Copy_Cfaild; 

procedure  Copy_Children  is  new  Children. Iterate (Copy_Chi Id) ; 
begin 

Clear (To_The_Tree) ; 
if  FroiiuThe_Tree  /=  null  then 

To_The_Tree  :  =  Node_Manager .  New_I  tern ; 
To_The_Tree.The_ltem  :=  Fronvjrhe_Tree .The^Item; 
Copy_Children (From_The_Tree . The_Children) ; 
end  if; 
exception 

when  Storage__Error  |  Children. Overflow  *> 
raise  Overflow; 
end  Copy; 

procedure  Clear  (The^Tree  :  in  out  Tree)  is 

procedure  Clear_Child  (The_Domain  :  in  Positive; 

The_Range  :  in  Tree ; 

Continue  :  out  Boolean)  is 

Teinporary_Node  :  Tree  :=  The_Range; 
begin 


Clear  { Tenporary^ode ) ; 

Continue  :=  True; 
end  Clear_Child; 

procedure  Clear_Children  is  new  Children. Iterate (Clear^Child) ; 
begin 

if  The_Tree  /=  null  then 

Clear_Children(The_Tree .The_Children) ; 

Node JMamager .  Free  (The_Tree) ; 
end  if; 
end  Clear; 

procedure  Construct  (The^Item  :  in  Item; 

AncLThe_Tree  :  in  out  Tree; 

Number_Of_Children  ;  in  Natural; 

On_The_Child  :  in  Natural)  is 

TeitporaryJMode  :  Tree ; 
begin 

if  Number_Of__Children  =  0  then 
if  And_The_Tree  =  null  then 

AndUThe_Tree  :=  Node_Manager.New__Item; 
AndLThe_Tree.The_Item  :=  The_ltem; 
return; 
else 

raise  Tree_Is_Not_Null; 
end  if; 

elsif  Onjrhe_Child  >  Number_Of_Children  then 
raise  ChilcLError; 
elsif  An(3LThe_Tree  =  null  then 

And_The_Tree  :=  Nodejlanager  .New_Item; 
And_'Ihe_Tree.The_Item  :=  The_Item; 
for  Index  in  1  . .  Number_Of_Children  loop 
Children, Bind (The_Domain  =>  Index, 

AncLThe_Range  =>  null, 

In_TheJKap  => 

And_The_Tree.The_Children) ; 
end  loop; 

elsif  And_The_Tree . Previous  =  null  then 

Tenporary_Node  :=  Node.Jl2uiager  .New_Item; 

Tenporary_Node . The_Item  ;=  The_Item; 
for  Index  in  1  . .  Number_Of_Children  loop 
if  Index  =  OrL_The_Child  then 
Children. Bind 

(TheJ3omain  =>  Index, 

And^The_Range  =>  And^The_Tree, 

In-The_Map  *>  Teiiporary_Node.The^Children) ; 

else 

Children . Bind 

(The^Domain  =>  Index, 

And_The_Range  =>  null, 

In_The_Map  =>  Temporary_Node.The_Children) ; 

end  if; 
end  loop; 

Anc3LThe_Tree .  Previous  ;  =  Terrporary_Node ; 

AncLThe_Tree  ;=  TeitporaryJNode; 

else 

raise  Not_At_Root; 
end  if; 
exception 

when  Storage_Error  |  Children. Over flow  => 
raise  Overflow; 
end  Construct; 

procedure  Set_Item  (Of_The_Tree  :  in  out  Tree; 

To_The_Item  :  in  Item)  is 

begin 

Of_The_Tree.The_Item  ;=  To_The_Item; 
exception 

when  Constraint_„Error  => 
raise  Tree_Is_Null; 
end  Set_Item; 

procedure  Swap_Child  (The_Child  :  in  Positive; 

Of_The_Tree  :  in  out  Tree; 

And^The_Tree  :  in  out  Tree)  is 
Teitporary_Node  :  Tree ; 
begin 

if  And_The_Tree  =  null  then 

Tenpor ary_Node  :  =  Chi  Idr en .  REuige_0  f 

(The_Doinain  =>  The_Chiid, 

In_The^ap  => 

Of_The_Tree .  The__Children)  ; 

Children. Unbind{The_Child,  Of_The_Tree.The_Children) ; 

Chi  Idr  en.  Bind  (The_Doinain  =>  The_Child, 

AncLThe_Range  =>  null, 

In_The_Map  =>  Of_The_Tree.The_Children) ; 
if  Teiiporary_Node  /=  null  then 

Temper ary_Node . Previous  :=  null; 
end  if ; 

And_The_Tree  : *  Temporary_Node ; 
elsif  AncLThe_Tree . Previous  =  null  then 
Teiiporary_Node  Children.Range_,Of 

(The_Domain  =>  The_Child, 

In_TheJ4ap  => 

Of_The_Tree.The_Children) ; 

Children. Unbind(The_Child,  Of_The_Tree  .The_Children) ; 

Chi Idren. Bind (The_Domain  =>  The_Child, 

And_The_Range  =>  And_The_Tree , 

In_The_Map  =>  Of_The_Tree,The_Children) ; 
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if  Teirporary_Node  /=  null  then 

Tenporary^ode .  Previous  :  =  null ; 
end  if; 

And_The_Tree . Previous  :=  Of_The_Tree; 
And_The_Tree  :=  Teii^orary_Node  ; 

else 

raise  Not_At_Root; 
end  if; 
exception 

when  Cons train t_Err or  => 

raise  Tree_Is_Null; 
when  Children, Domain_IsJNot_Bound  => 
raise  Child_Error; 
end  Swap_Child; 


—  modified  by  Tuan  Nguyen 

—  25  December  1995 

adding  procedures  to  replace  functions 

procedure  Is__Equal  (Left 

Right 

Result 

begin 

Result  : =  Is_Equal (Left , Right ) ; 
end  Is_Egual; 

procedure  Is_Null  (The_Tree 

Result 

begin 

Result  ;=  Is_Null{The_Tree) ; 
end  Is^Null; 

procedure  ItenuOf  (The_Tree 

Result 

begin 

Result  : =  I t enuOf ( The_Tr ee ) ; 
end  IteirL_Of; 


in  Tree; 
in  Tree; 
out  Boolean)  is 


in  Tree; 

out  Boolean)  is 


in  Tree) ; 
out  Item)  is 


procedure  Number_Of_Children_In  (The_Tree 

Result 


in  Tree; 

out  Natural )  is 


begin 

Result  : ~  Number^Of _Children„In ( The_Tree ) ; 
end  Nuinber_Of_Children_In; 


else 

Continue  : =  True ; 
end  if; 

end  Check_Child_Equality; 
procedure  Check_E<^ality  is  new 
Children. Iterate (Check_Child_Equality) ; 
begin 

if  Left.The_Item  /=  Right .The_I tern  then 
return  False; 

if  Children. Extent^Of (Left. The^Children)  /= 

Children . Extent_Of ( Right . The_Children )  then 
return  False; 

else 

Check^Equality { Left . The^Children) ; 
return  Trees^Are_Equal; 
end  if; 
end  if; 
exception 

when  Constraint_Error  *> 

return  (Left  =  Null_Tree)  and  (Right  =  Null_Tree) ; 
end  Is_Equal ; 

function  Is_Null  (The_Tree  :  in  Tree)  return  Boolean  is 
begin 

return  (The_Tree  =  null) ; 
end  IsJJull; 


function  IteirL.Of  (The_Tree  :  in  Tree)  return  Item  is 
begin 

return  The_Tree.The_Item; 
exception 

when  Constraint_Error  «> 
raise  Tree_Is_JIull; 
end  IteituOf; 

function  Nurciber_Of_Children_In  (The_Tree  :  in  Tree)  return  Natural 
begin 

re  turn  Children . Ext ent_0 f { The_Tr e e . The_Chr Idren )  ; 
exception 

when  Constraint„Error  => 
raise  Tree_Is JIull ; 
end  Nuinber_Of_Children_In; 


procedure  Child_Of  (The_Tree  :  in  Tree; 

The_Child  :  in  Positive; 

Result  :  out  Tree)  is 

begin 

Resul t  : =  Chi IcLOf ( The_Tr ee , The_Chi Id ) ; 
end  Child_Of; 

—  end  of  modification 

function  Is_Equal  (Left  :  in  Tree; 

Right  ;  in  Tree)  return  Boolean  is 
Trees_Are_Equal  ;  Boolean  :=  True; 

procedure  Check^Child^Equality  (The_Domain  :  in  Positive; 

The^Range  :  in  Tree; 

Continue  :  out  Boolean)  is 

begin 

if  not  Is_Equal(The_Range, 

Children . Range_Of ( The_Domain , 

Right . The_Children) ) 

then 

Trees^Are„Equal  :=  False; 

Continue  ;=  False; 


function  Child__Of  (The_Tree  :  in  Tree; 

The_Child  ;  in  Positive)  return  Tree  is 

begin 

return  Children. Range_Of (The_Domain  =>  The_Child, 

In_The_Map  =>  The_Tree.The_Children) ; 

exception 

when  Constraint_Error  => 

raise  Tree_IsJNull; 
when  Children. Domain_ls_JIot_Bound  => 
raise  Child^Error; 
end  Child_Of; 

fxjnction  Parent_Of  (The^Tree  ;  in  Tree)  return  Tree  is 
begin 

return  The_Tree. Previous; 
exception 

when  Constraint_Error  => 
raise  Tree_Is_Null ; 
end  Parent_Of; 

end  Tre  e .Arbi tr ary_Double_Unbounded_Nanaged ; 
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TREE  ARBITRARY  DOUBLE  UNBOUNDED  MANAGED 


PSDL 


TYPE  Tree^Arbi  t rary_Doubie_Unbouiided ^Managed 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE^TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

Fromjrhe_Tree  :  Tree, 

To__The_Tree  :  Tree 
OUTPUT 

To_The_Tree  :  Tree 
EXCEPTIONS 

Overflow,  Tree_Is_Null,  Tree_Is_Not_Null,  Not^t_Root, 
ChildLError 
END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Tree  ;  Tree 
OUTPUT 

The^Tree  :  Tree 
EXCEPTIONS 

Overflow,  Tree_Is_Null ,  Tree_IsJtfot_Null ,  Not_At_Root, 
ChildLError 
END 

OPERATOR  Construct 
SPECIFICATION 
INPUT 

The^Item  :  Item, 

AndLThe_Tree  :  Tree, 

Number_Of_Children  :  Natural, 

On_The_Child  ;  Natural 
OUTPUT 

And_The_Tree  ;  Tree 
EXCEPTIONS 

Overflow,  Tree_Is_Null,  Tree_Is_Not_Null ,  NotLAt_Root, 
ChildLError 
END 


OPERATOR  Set_Item 
SPECIFICATION 
INPUT 

Of_The_Tree  :  Tree, 

To_The_Item  :  Item 
OUTPUT 

Of_The_Tree  :  Tree 
EXCEPTIONS 

Overflow,  Tree_ISLNull,  Tree_Is_Not_Null,  NotLAt_Root 
ChildLError 
END 

OPERATOR  Swap_Child 
SPECIFICATION 
INPUT 

The_Child  :  Positive, 

Of_The_Tr ee  :  Tree , 

AncL.The_Tree  :  Tree 
OUTPUT 

Of_The_Tree  :  Tree, 

And_The_Tree  ;  Tree 
EXCEPTIONS 


Overflow,  Tree_Is_Null ,  Tree_Is_Not_Null,  NotJAt_Root, 
ChildLError 
END 

OPERATOR  IS_Egual 
SPECIFICATION 
INPUT 

Left  :  Tree, 

Right  :  Tree 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Tree_Is_Null ,  Tree_Is_Not_Null,  NotLAt_Root, 
ChildLError 
END 

OPERATOR  Is_JIull 
SPECIFICATION 
INPUT 

The_Tree  :  Tree 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Tree_IsJN'ull ,  Tree_IsJNot_Null,  NotLAt_Root, 
ChildJError 
END 

OPERATOR  ItenuOf 
SPECIFICATION 
INPUT 

The_Tree  :  Tree 
OUTPUT 

Result  :  Item 
EXCEPTIONS 

Overflow,  Tree_Is_Null ,  Tree_Is^ot_Null ,  Not_At_Root, 
ChildLError 
END 

OPERATOR  Number_Of_Children_In 
SPECIFICATION 
INPUT 

The_Tree  :  Tree 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Tree_Is JIull ,  Tree_Is_NotJNull,  Not_At_Root, 
Child_Error 
END 

OPERATOR  ChilcLOf 
SPECIFICATION 
INPUT 

The_Tree  :  Tree, 

The_Child  ;  Positive 
OUTPUT 

Result  :  Tree 
EXCEPTIONS 

Overflow,  Tree_IsJJull,  Tree_Is_Not JNull ,  NotLAt_Root, 
ChildLError 
END 

END 

IMPLEMENTATION  ADA  TreeLArbitrary_Double_Uiibo;mdedJManaged 
END 
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TREE  ARBITRARY  DOUBLE  UNBOUNDED  UNMANAGED 


ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

EbqpectedJJioirtoer.Of .Children  :  in  Positive; 
package  Tree^Arbitrary_Dovible_Unbounded_Unmanaged  is 


type  Tree 

is  private; 

Null.Tree 

:  constant 

Tree; 

procedure 

Copy 

( From_The_Tree 

in 

Tree; 

To.The.Tree 

in 

out 

Tree) ; 

procedure 

Clear 

(The.Tree 

in 

out 

Tree) ; 

procedure 

Construct 

(The.Item 

in 

Item; 

AncL_The_Tree 

in 

out 

Tree; 

Number.Of.Children 

in 

Natural; 

Qn.The.Child 

in 

Natural) 

procedure 

Set.Item 

(Of. The.Tree 

in 

out 

Tree; 

To.The.Item 

in 

Item) ; 

procedure 

Swap.Child 

(The.Child 

in 

Positive 

Of.The.Tree 

in 

out 

Tree; 

And^The.Tree 

in 

out 

Tree) ; 

procedure  Number.Of.Children.In 

,  (The.Tree 

:  in  Tree ; 

Result 

:  out  Natural) 

procedure  Child.Of 

(The.Tree 

:  in  Tree; 

The.Child  : 

:  in  Positive; 

Result 

:  out  Tree) ; 

—  end  of  modification 

function  Is.Equal 

(Left 

:  in  Tree ; 

Right 

:  in  Tree ) 

Boolean; 

function  Is.Null 

(The.Tree 

:  in  Tree) 

Boolean; 

function  Item_Of 

(The.Tree 

:  in  Tree } 

Item; 

function  Number.Of.Children.In 

(The.Tree 

:  in  Tree ) 

Natural ; 

function  Child_Of 

(The.Tree 

:  in  Tree; 

The.Child  ; 

;  in  Positive) 

Tree; 

function  Parent.Of 

(The.Tree 

:  in  Tree ) 

Tree; 

—  modified  by  Tuan  Nguyen 

—  25  December  1995 

—  adding  procedures  to  replace  functions 


procedure  Is.Equal 

procedure  Is.Null 
procedure  ItenuOf 


(Left 

Right 

Result 

(The.Tree 

Result 

(The.Tree 

Result 


in  Tree; 
in  Tree; 
out  Boolean) ; 
in  Tree; 
out  Boolean) ; 
in  Tree ) ; 
out  Item) ; 


Overflow 
Tree.IsJJull 
Tree_Is.No t JNul 1 
Not_At.Root 
Child_Error 


exception; 

exception; 

exception; 

exception; 

exception; 


private 

type  Node; 

type  Tree  is  access  Node; 

Null.Tree  :  constant  Tree  :=  null; 
end  Tr e  e.Arbi  t rary.Double.Unbounded.Unmanaged ; 


return 

return 

return 

return 

return 

return 
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TREE  ARBITRARY  DOUBLE  UNBOUNDED  UNMANAGED 


ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Nuntoer  0100219 

—  "Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Computer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer; 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

with  Map_Sinple JIoncached_Sec3uent ial_Unbounded^Uninanage<^I terator  ; 
package  body  Tree_J^bitrary_Double_Unboundec5LUninanaged  is 

function  Hash_Of  (The_Child  ;  in  Positive)  return  Positive; 


package  Children  is  new 

Map_Siinple_J4oncached>.Sequential_UnboimdedLUnnanagedLlterator 
(Domiain  =>  Positive, 

Ranges  =>  Tree, 

Nuinber_Of_Buckets  =>  Expected_^Iuinber_Of_Children, 

Hash_0f  =>  Hash_0f); 


type  Node  is 
record 

Previous 
The^Item 
The_Children 
end  record; 


Tree; 

Item; 

Children .  Map ; 


function  Hash_Of  (The_Child  :  in  Positive)  return  Positive  is 
begin 

return  The_Child; 
end  HaslL_Of; 


procedure  Copy  (FronuThe_Tree  :  in  Tree; 

To_The_Tree  :  in  out  Tree)  is 

procedure  Copy^Child  (The_Domain  :  in  Positive; 

The_Range  :  in  Tree ; 

Continue  :  out  Boolean)  is 

Teinporary_Node  :  Tree  ; 
begin 

Copy  (The_Range,  To_Thc_Tree  =>  Teinporary_^ode )  ; 
Children-Bind(The„Doinain,  Tenporary_^ode , 

In_The_Map  =>  To_The_Tree.The_Children) ; 
if  Temporary^Node  /=  Null_Tree  then 

Temporary JMode .  Previous  ;  =  To_The_Tree  ; 
end  if; 

Continue  : =  True ; 
end  Copy_Child; 

procedure  Copy^Children  is  new  Children. Iterate (Copy_Child)  ; 
begin 

if  FromuThe_Tree  =  null  then 
To_The_Tree  :=  null; 

else 

To_The_Tree  ;=  new  Node; 

To_The_Tree,The_ltemi  :=  Fronv_The_Tree.The_Item; 
Copy_Children  {Froin_The_Tree .  The_Children) ; 
end  if; 
exception 

when  Storage^Error  |  Children. Over flow  => 
raise  Overflow; 
end  Copy; 

procedure  Clezu:  (The^Tree  :  in  out  Tree)  is 
begin 

The_Tree  null ; 
end  Clear; 


procedure  Construct  (The_Item 

:  in 

Item; 

And..The_Tree 

:  in 

out  Tree; 

Ntunber_0  f  _Chi  Idren 

:  in 

Natural; 

On_The_Child 
TemporaryJNode  :  Tree ; 
begin 

if  Nuinber_Of_Chi Idren  =  0  then 
if  And_The-Tree  =  null  then 

And— The_Tree  :=  new  Node; 

:  in 

Natural)  is 

And-The— Tree. The-I tern  :=  The. 
return; 

.Item; 

else 

raise  Tree_Is_Not_Null ; 
end  if; 

elsif  On_The_Child  >  Nuinber_0£_Children  then 
raise  Child^Error; 

elsif  And^The_Tree  =  null  then 
AndJThe^Tree  ;=  new  Node; 

AncLThe_Tree  .The_Item  :=  The_Item; 
for  Index  in  1  . .  Number^Of ..Children  loop 
Children. Bind (The_Domain  =>  Index, 
AndL_The_Range  =>  null, 
In_TheJMap  => 

Anc2LThe_Tree.The_Children)  ; 
end  loop; 

elsif  AncaLThe_Tree . Previous  =  null  then 


Temporary Jlode  :=  new  Node; 

Temporary_Node  .The_Item  ;=  The_Itein; 
for  Index  in  1  , .  Nurnber_Of_Children  loop 
if  Index  =  On_The_Child  then 
Children . Bind 

(The_Domain  =>  Index, 

And_The_Range  =>  And_The_Tree , 

In_The_Map  =>  Temper ary_Node. The_Children )  ; 

else 

Children . Bind 

(The^Domain  =>  Index, 

And_The_Range  =>  null, 

In_The_Map  =>  Temper ary JNode. The_Childr en ) ; 

end  if; 
end  loop; 

AncLThe_Tree .  Previous  :  =  Temper ary_Node  ; 

AndLThe_Tree  :=  Temper aryJJode; 

else 

raise  Not.J^t_Root  ; 
end  if; 
exception 

when  Storage_Error  |  Children. Over flow  => 
raise  Overflow; 
end  Construct; 


procedure  Set_Item  {Of_The_Tree  :  in  out  Tree; 

To_The_Item  :  in  Item)  is 

begin 

Of_The„Tree.The_Item  :=  To_The_Item; 
exception 

when  Constraint_Error  => 
raise  Tree_Is_JJull; 
end  Set^Item; 


procedure  Swap_Child  (The^Child  :  in  Positive; 

Of_The_Tree  :  in  out  Tree; 

And_The_Tree  :  in  out  Tree)  is 
Temporary Jlode  :  Tree  ; 
begin 

if  And_The_Tree  =  null  then 

Tenporary_Node  :=  Children.Range_Of 

(The_Domain  =>  The^Child, 

In_TheJIap  => 

Of_The_Tree.The_Children) ; 

Children. Unbind{The_Child,  Of_The_Tree .The_Children)  ; 
Children .  Bind  ( The_Domiain  =>  The_Chi Id , 

And_The_Range  =>  null, 

In_The_Map  ->  Of_The_Tree.The_Children) ; 
if  TemporaryJJode  /=  null  then 

Temporary_Node . Previous  :=  null; 
end  if; 

AncLThe_Tree  :==  Teirporary_Node; 
elsif  And_The_Tree . Previous  =  null  then 
TemporaryJJode  :=  Children.Range_Of 

{The_Domain  =>  The_Child, 

In_The_Map  -> 

Of _The_Tree .  The_Chi  Idren )  ; 

Children. Unbind(The_Child,  Of_The_Tree.The_Children) ; 
Children .  Bind  { The JDomain  =  >  The_Chi Id , 

And_The_Range  s=>  AncSLThe_Tree , 

In_The_Map  ->  Of_The_Tree  .The^Children) ; 
if  TemporaryJNode  /=  Null_Tree  then 
Temporary_Node . Previous  : =  null ; 
end  if; 

AncLThe_Tree . Previous  :=  Of_The_Tree; 

And_The_Tree  :=  Temper  ary JMode  ; 
else 

raise  Not^t_Root; 
end  if; 
exception 

when  Constraint_Error  => 

raise  Tree_Is_Null; 
when  Children. Domainal s.JJot_Bound  => 
raise  Child-Error; 
end  Swap—Child; 


—  modified  by  Tuan  Nguyen 

—  25  December  1995 

—  adding  procedures  to  replace  functions 

procedure  Is_Equal  (Left 

Right 

Result 

begin 

Result  ;=  Is_Equal (Left, Right) ; 
end  Is_Equal; 

procedure  Is..Null  (The_Tree 

Result 

begin 

Result  :=  IsJIull  (The_Tree)  ; 
end  Is_Null; 

procedure  Itemv-Of  (The_Tree 

Result 

begin 

Result  :=  Itemt-Of  (The_Tree) ; 
end  Item_0f; 


in  Tree; 
in  Tree; 
out  Boolean)  is 


in  Tree; 

out  Boolean)  is 


in  Tree) ; 
out  Item)  is 
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procedure  Nuitiber_Of_Children_In  (The_Tree  :  in  Tree; 

Result  ;  out  Natural)  is 


when  Constraint_Error  -> 

return  {Left  =  Null_Tree)  and  (Right  -  Null_Tree) ; 
end  Is_Equal; 


begin 

Result  ;  =  Nuinber_0 f _Ch i Idr en_In  ( The_Tr ee )  ; 
end  Nuinber_Of_Children_In; 


procedure  ChilcLOf 


(The_Tree  : 
The_Child  : 
Result  : 


begin 

Result  := 
end  Child_Of; 


Child^Of (The_Tree,The_Child} ; 


in  Tree; 
in  Positive; 
out  Tree)  is 


end  of  modification 


function  Is_Null  (The_Tree  ;  in  Tree)  return  Boolean  is 
begin 

return  (The_Tree  =  null); 
end  Is_^ull; 

function  IteirL_Of  {The_Tree  :  in  Tree)  return  Item  is 
begin 

return  The_Tree.The_Item; 
exception 

when  Cons train t_Err or  => 
raise  Tree_IsJ^ull; 
end  IteiruOf; 


function  Is_Equal  (Left  :  in  Tree; 

Right  ;  in  Tree)  return  Boolean  is 
Trees.J^e_Egual  :  Boolean  :=  True;  ^  _ 

procedure  Check_Child_Equality  (The_Doinain  :  in  Positive; 

The_Range  :  in  Tree ; 

Continue  :  out  Boolean)  is 

begin 

if  not  Is_Equal{The_Range, 

Chi  Idren .  Range^Of  { The_Doinain , 

Right . The_Children) ) 


then 

Trees_Are_Equal  :=  False; 
Continue  :=  False; 


else 

Continue  :=  True; 
end  if; 

end  Check_Child_Equality; 
procedure  Check__Equality  is  new 
Children. Iterate (Check_Child_Eguality) ; 
begin 

if  Left.The_Item  /=  Right .The_I tern  then 
return  False; 


if  Children. Extent_Of (Left. The_Children)  /= 

Children . Extent^Of (Right . The_Children)  then 
return  False; 

else 

Check_Equality (Left .The_Chi Idren) ; 
return  Trees^Are_Equal; 
end  if; 
end  if; 
exception 


fiinction  Nuinber_Of_Children_In  (The_Tree  :  in  Tree)  return  Natural 
begin 

return  Children . Extent_Of (The_Tree . The_Children) ; 
exception 

when  Const rain t_Err or  => 
raise  Tree_IsJJull; 
end  Number_Of_Children_In; 


function  Child^Of  (The^Tree  :  in  Tree; 

The_Child  ;  in  Positive)  return  Tree  is 

begin 

return  Chi  Idren.  Range^O  f  (The^Domain  =>  The^Child, 

In_The_Map  =>  The_Tree.The_Children); 

exception 

when  Const rain t_Err or  => 

raise  Tree_Is_Null; 
when  Children. Domain_Is_Not_Bound  => 
raise  ChildLError; 
end  ChilcLOf; 

function  Parent_Of  (The^Tree  :  in  Tree)  return  Tree  is 
begin 

return  The_Tr ee . Previous ; 
exception 

when  Constraint_Error  => 
raise  Tree^Is_JIull  ; 
end  Parent_Of; 

end  Tree_^bitrary_Double_Unbounded_Uninanaged; 


296 


TREE  ARBITRARY  DOUBLE  UNBOUNDED  UNMANAGED 


PSDL 


TYPE  Tree_Arbitrary_Double_UiiboundedLUnmanaged 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

Fromjrhe_Tree  ;  Tree, 

To_The_Tree  :  Tree 
OUTPUT 

To_The__Tree  :  Tree 
EXCEPTIONS 

Overflow,  Tree_lsjlull,  Tree_Is_Not_Null,  Not^t_Root, 
Child^Error 
END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The^Tree  :  Tree 
OUTPUT 

The_Tree  :  Tree 
EXCEPTIONS 

Overflow,  Tree_IsJ«ull,  Tree_Is^ot_Null,  Not^t_Root, 
ChildLError 
END 

OPERATOR  Construct 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

AndLThe_Tree  :  Tree, 

N\jmber_Of_Children  :  Natural, 

On_The_Child  :  Natural 
OUTPUT 

AncLThe_Tree  :  Tree 
EXCEPTIONS 

Overflow,  Tree_Is_Null,  Tree_Is_Not JNull ,  Not^t_Root, 
Child^Error 
END 

OPERATOR  Set_Item 
SPECIFICATION 
INPUT 

Of_The_Tree  :  Tree, 

To_The_Item  :  Item 
OUTPUT 

Of_The_Tree  :  Tree 
EXCEPTIONS 

Overflow,  Tree_Is_.Null,  Tree_Is_Not_Null,  Not_At_Root, 
Child^Error 
END 

OPERATOR  Swap_Child 
SPECIFICATION 
INPUT 

■Kie^Child  :  Positive, 

Of_The_Tree  ;  Tree, 

And_The_Trce  :  Tree 
OUTPUT 

Of_The_Tree  :  Tree, 

And_The_Tree  ;  Tree 
EXCEPTIONS 


Overflow,  Tree_Is_Null,  Tree_.Is_Not.JIull,  Not_jAt_Root, 
Child^Error 
END 

OPERATOR  Is_Equal 
SPECIFICATION 
INPUT 

Left  :  Tree, 

Right  :  Tree 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Tree_IsJNull ,  Tree_Is_Not__Null,  Not_At_Root, 
Child^Error 
END 

OPERATOR  Is_Null 
SPECIFICATION 
INPUT 

The_Tree  :  Tree 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Tree_Is_^ull ,  Tree_Is_Notjaull,  Not_At_Root, 
Child^Error 
END 

OPERATOR  IteiTL^Of 
SPECIFICATION 
INPUT 

TheJTree  :  Tree 
OUTPUT 

Result  :  Item 
EXCEPTIONS 

Overflow,  Tree_Is_Null ,  Tree_lsJTotJNull,  Not_At_Root, 
Child^Error 
END 

OPERATOR  Number_Of_Children_In 
SPECIFICATION 
INPUT 

TheJTree  :  Tree 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Tree_Is_JJull,  Tree_Is_Not_Null,  Not^t_Root, 
Child_Error 
END 

OPERATOR  Child_Of 
SPECIFICATION 
INPUT 

TheJTree  :  Tree, 

The_Child  :  Positive 
OUTPUT 

Result  :  Tree 
EXCEPTIONS 

Overflow,  Tree_IsJMull,  Tree_Is^otJNull ,  Not_At_Root, 
Child^Error 
END 

END 

IMPLEMENTATION  ADA  Tree_^bitrary_Double_UnboundedLUnmanaged 
END 
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TREE  ARBITRARY  SINGLE  UNBOUNDED  MANAGED 


ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

Expected^Nuinber_Of_Children  :  in  Positive; 
package  Tree_J^bitrarY_Single_UnboiindedJ!anaged  is 

type  Tree  is  private; 


Result 

procedure  Number_Of_Children_In  (The^Tree 

Result 

procedure  ChildLOf  (The_Tree 

The_Child 

Result 

end  of  modification 


:  out  Item)  ; 

;  in  Tree; 

;  out  Natural) ; 
:  in  Tree; 

;  in  Positive; 

;  out  Tree) ; 


Null_Tree  :  constant  Tree; 


procedure  Copy 

procedure  Clear 
procedure  Construct 


procedure  Set_Item 
procedure  Swap_Child 


{ From-.'ilie_Tree 
To_The_Tree 
( The_Tree 
(The_Item 
AndLThe_Tree 
Number^O f _Ch i Idr en 
On_The__Child 
(Of_The_Tree 
To_The_Item 
{The_Child 
Of_The_Tree 
And_The_Tree 


in  Tree  ; 
in  out  Tree) ; 
in  out  Tree) ; 
in  I  tern; 
in  out  Tree; 
in  Natural; 
in  Natural)  ; 
in  out  Tree; 
in  Item)  ; 
in  Positive; 
in  out  Tree; 
in  out  Tree) ; 


—  modified  by  Tuan  Nguyen 

—  25  December  1995 

—  adding  procedures  to  replace  fimctions 


fxanction 

Boolean; 

function 

Boolean; 

function 

Item; 

function 
Natural ; 

function 


Is^Egual 

{Left 

Right 

:  in  Tree; 

:  in  Tree) 

return 

Is_Null 

(The^Tree 

:  in  Tree) 

return 

ltem_of 

(The_Tree 

:  in  Tree ) 

return 

Number_Of _Chi Idr en_In 

(The_Tree 

:  in  Tree) 

return 

ChildLOf 

(The_Tree 
The^Child  ; 

:  in  Tree; 

:  in  Positive) 

return 

Tree; 


Overflow 
Tree_Is_Null 
Tr  ee_I  s_JJo  t  JNul  1 
ChildLError 


exception; 

exception; 

exception; 

exception; 


procedure  Is^Equal 

procedure  Is^ull 
procedure  IterrL_Of 


{Left 

Right 

Result 

(The_Tree 

Result 

{The_Tree 


in  Tree; 
in  Tree; 
out  Boolean) ; 
in  Tree; 
out  Boolean) ; 
in  Tree) ; 


private 

type  Node; 

type  Tree  is  access  Node; 

Null^Tree  :  constant  Tree  :=  null; 
end  TreelArbitrary_Single_UnboundedJlanaged; 
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TREE  ARBITRARY  SINGLE  UNBOUNDED  MANAGED 


ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 


if  The^Tree  /=  null  then 

Clear_Chi Idren ( The_Tree . The_Chi Idr en ) ; 
Node_Nanager . Free {The_Tree) ; 
end  if; 
end  Clear; 


"Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  sxibject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  and  Conputer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

with  Map_Sinple JJoncachedLSe<^ential_Unbo\inded_Managed_I terator , 
Storage_Manager_Sequential ; 

package  body  Tree_Ai^bitrary_Single_UnboundecLManaged  is 

function  Hash^Of  (The_Child  :  in  Positive)  return  Positive; 
package  Children  is  new 

Map_Simple_Noncached_Sequential_Unbounded_ManasrecLIterator 
(Domain  =>  Positive, 

Ranges  =>  Tree, 

Nxainber_Of_Buckets  =>  Expected_Number_Of_Children, 

Hash_Of  =>  Hash_Of); 

type  Node  is 
record 

The_Item 
The_Chi Idren 
Next 

end  record; 

function  Hash_Of  (The_Child  :  in  Positive)  return  Positive  is 
begin 

return  The_Child; 
end  HaslL_Of; 

procedure  Free  (The_Node  :  in  out  Node)  is 
begin 

Children .Clear (The_Node .The_Chi Idr en) ; 
end  Free; 


;  I  tern; 

:  Children. Map ; 
;  Tree ; 


procedure  Construct  (The^Item  : 

And_The_Tree 
Nuinber_Of_Children  ; 
On^The^Child  : 

Teniporary_Node  :  Tree ; 
begin 

if  Number_Of_Children  =  0  then 
if  And_The_Tree  =  null  then 

AncLThe_Tree  Nodejlanager  .New_Item; 
And_The_Tree.The_Item  :=  The_Item; 
else 

raise  Tree_Is_Not^ull ; 
end  if; 

elsif  Onjrhe_Child  >  Number_Of_Children  then 
raise  ChilcLError; 

else 


in  I  tern; 

in  out  Tree; 
in  Natural; 

in  Natural) 


is 


Tenporary_Node  ;=  Node_Manager.New_Item; 
TeiiporaryJNode.The_Item  :=  The_Item; 
for  Index  in  1  . .  Number_Of_Children  loop 
if  Index  =  On_The_Child  then 
Children . Bind 

{The_Domain  =>  Index, 

AncLThe_Range  =>  And_The_Tree , 

In_The„Map  =>  TertporaryJJode.The^Children)  ; 

else 


Children. Bind 

(The_Domain  =>  Index, 

And_The_Rcuige  =>  null, 

In_The_Map  =>  Tertiporary^ode  .The_Children)  ; 

end  if; 
end  loop; 

And_The_Tree  :  =  TeiTporary_Node  ; 
end  if; 
exception 

when  Storage_Error  |  Children. Over flow  => 
raise  Overflow; 
end  Construct; 


procedure  Set_Next  (The_Node  :  in  out  Node; 

To_Next  :  in  Tree)  is 

begin 

The_Node.Next  :=  To^Next; 
end  Set_Next; 

function  Next_Of  (The_Node  :  in  Node)  return  Tree  is 
begin 

return  The JJode. Next; 
end  Next_Of; 

package  Node_Manager  is  new  StorageJM[anager_Sequential 

(Item  =>  Node, 

Pointer  =>  Tree, 

Free  =>  Free, 

Set_Pointer  =>  SetJtJext, 
Pointer_Of  =>  Next_0f ) ; 

procedure  Copy  ( Froin_The_Tree  :  in  Tree; 

To_The_Tree  :  in  out  Tree)  is 

procedure  Copy_Child  (The_Domain  :  in  Positive; 

The_Range  :  in  Tree; 

Continue  :  out  Boolean)  is 

Teinporary_Node  :  Tree ; 
begin 

Copy  (The^Range,  To_The_Tree  =>  TemporaryJHode) ; 

Children .  Bind  ( The_Doinain ,  Temporary Jlode , 

In_The_Map  =>  To_The„Tree.The_Children)  ; 
Continue  :=  True; 
end  Copy_Child; 

procedure  Copy_Children  is  new  Children. Iterate (Copy_Child) ; 
begin 

Clear { To_The_Tree ) ; 
if  FroirL_The_Tree  /=  null  then 

To_The_Tree  :=  Node_Manager.New_Item; 

To^The_Tree.The_Item  :=  FrorrL_The^Tree.The_Item; 
Copy_Children  ( FronL.The_Tree .  The_Cbildren)  ; 
end  if; 
exception 

when  Storage_Error  }  Children. Overflow  => 
raise  Overflow; 
end  Copy; 

procedure  Clear  (The_Tree  :  in  out  Tree)  is 

procedure  Clear^Child  (The_Domain  :  in  Positive; 

The_Range  :  in  Tree; 

Continue  :  out  Boolean)  is 

Ten^Jorary^Node  :  Tree  :=  The_Range; 
begin 

Clear  (Ten?)orary_Node)  ; 

Continue  :=  True; 
end  Clear_Child; 

procedure  Clear_Children  is  new  Children. Iterate (Clear^Child) ; 
begin 


procedure  Set_Itein  (Of_The_Tree  :  in  out  Tree; 

To_The_Item  :  in  Item)  is 

begin 

Of_The_Tree.The_Item  :=  To_The_Item; 
exception 

when  Constraint_Error  => 
raise  Tree_Is_Null; 
end  Set_Item; 

procedure  Swap_Child  (The_Child  :  in  Positive; 

Of_The_Tree  :  in  out  Tree; 

Ancl_The_Tree  :  in  out  Tree)  is 
Temporary_Node  :  Tree; 
begin 

Tenporary_JIode  :=  Children.Range_Of 

(The_Domain  =>  The_Child, 

In_The_Map  =>  Of_The_Tree.The_Children); 
Chi Idren. Unbind (The^Child,  Of_The_Tree.The_Children) ; 
Children. Bind {The_Domain  =>  The_Child, 

AndLThe_Range  =>  And_The_Tree, 

In_The_Map  =>  Of_The_Tree .The_Children) ; 
And_The_Tree  :=  Tenpor ary_Node ; 
exception 

when  Constraint_Error  => 

raise  Tree_Is^ull; 
when  Children. Doinain_Is_JIot_Bo\md  => 
raise  Child^Error; 
end  Swap_Child; 

modified  by  Tuan  Nguyen 
25  December  1995 

adding  procedures  to  replace  functions 

procedure  Is_Equal  (Left 

Right 
Result 

begin 

Result  :=  Is_Equal (Left, Right) ; 
end  Is_Equal; 

procedure  Is_Null  (The_Tree 

Result 

begin 

Result  :=  Is_Null (TheJTree) ; 
end  Is_Null; 

procedure  ItenuOf  (The_Tree 

Result 

begin 

Result  :=  ItenuOf (The_Tree) ; 
end  Item_Of; 

procedure  Number^Of_Children_In  (The_Tree 

Result 


;  in  Tree ; 

:  in  Tree ; 

:  out  Boolean)  is 


:  in  Tree ; 

:  out  Boolean)  is 


;  in  Tree ) ; 

:  out  Item)  is 


:  in  Tree ; 

:  out  Natural)  is 
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procedure  ChilcL_Of 


begin 

Result  : =  Number^O f _Chi Idr en_In ( The_Tr ee ) ; 
end  Nurnber_Of_Children_In; 

(The_Tree  :  in  Tree; 

The_Child  :  in  Positive ; 

Result  :  out  Tree)  is 

begin 

Result  :=  ChilcLOf  {The_.Tree,The_Child)  ; 

end  Child_oe; 

—  end  of  modification 

function  Is^Egual  (Left  ;  in  Tree; 

Right  :  in  Tree)  return  Boolean  rs 
Trees^Are_Equal  :  Boolean  True;  _  _ 

procedure  Check_Child_Equality  (The^Domain  :  in  Positive; 

The_Range  :  in  Tree; 

Continue  :  out  Boolean)  is 

begin 

if  not  Is_Equal(The_Range, 

Children.Range_Of (The_Domain, 

Right. The_Children) ) 

then 

Trees_Are_Equal  : =  False ; 

Continue  :=  False; 

else 

Continue  True; 
end  if; 

end  Check_Child_Equality; 
procedure  Check^Equality  is  new 
Children. Iterate {Check_Child_Equality)  ; 
begin 

if  Left.The^Item  /=  Right .The_Item  then 
return  False; 

else 

if  Children. Extent_Of (Left. The^Children)  I- 

Children .  Extent_Of  (Right  .The_Children)  then 
return  False; 

else 

Check_Equality(Left.The_Children) ; 
return  Trees_^e_Equal  ; 


end  if; 
end  if; 
exception 

when  Constraint_Error  => 

return  (Left  =  Null_Tree)  and  (Right  =  Null_Tree) ; 
end  Is_Equal; 

function  IsJJull  (The_Tree  :  in  Tree)  return  Boolean  is 
begin 

return  (The_Tree  =  null); 
end  Is_Null; 

function  Item_Of  (The_Tree  :  in  Tree)  return  Item  is 
begin 

return  The_Tree.The_Iteiii; 
exception 

when  Constraint_Error  => 
raise  Tree_ls_JIull  ; 
end  Item_Of; 

function  Number_Of_Children_In  (The^Tree  :  in  Tree)  return  Natural 
is 

begin 

return  Children . Extent_Of (The^Tree . The_Children) ; 
exception 

when  Constraint_Error  => 
raise  Tree_Is_Null ; 
end  Number_Of_Children_In; 

function  Child_Of  (The^Tree  :  in  Tree; 

■nie_Child  :  in  Positive)  return  Tree  is 

begin 

return  Children. Range^Of (The_Domain  =>  The_Child, 

InL.The_Map  =>  The_Tree.The_Children) ; 

exception 

when  Constraint_Error  => 

raise  Tree_Is_Null ; 
when  Children. Domainal sJNot_Bound  => 
raise  Child_Error; 
end  Child_Of ; 

end  Tr ee_Arbi  t r ary_Single_Unbounded JManaged ; 
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TREE  ARBITRARY  SINGLE  UNBOUNDED  MANAGED 


PSDL 


TVTPE  Tree.^bi  t r ary_Sing  le.Unbounded^anaged 
SPECIFICATION 
GENERIC 

Item  :  PRIVATE_TypE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

FroiiL_The_Tree  :  Tree, 

To_The_Tree  :  Tree 
OUTPUT 

To_The_Tree  ;  Tree 
EXCEPTIONS 

Overflow,  Tree_Is_Null ,  Tree_Is_Not_JIull,  Child^Error 

END 

OPERATOR  Clear 
SPECIFICATION 
INPUT 

The_Tree  :  Tree 
OUTPUT 

The_Tree  :  Tree 
EXCEPTIONS 

Overflow,  Tree_Is_Null,  Tree_Is_Not_Null,  Child_Error 

END 

OPERATOR  Construct 
SPECIFICATION 
INPUT 

The_Item  :  Item, 

And_The_Tree  :  Tree, 

N\aitiber_Of_Children  :  Natural, 

On_The_Child  :  Natural 
OUTPUT 

And_The_Tree  :  Tree 
EXCEPTIONS 

Overflow,  Tree_Is_^ull,  Tree_Is_Not_Null,  Child^Error 

END 

OPERATOR  Set_Item 
SPECIFICATION 
INPUT 

Of _The_Tree  :  Tree , 

To_The„Item  :  Item 
OUTPUT 

Of_The_Tree  :  Tree 
EXCEPTIONS 

Overflow,  Tree_Is_Null,  Tree_Is^ot_Null,  Child^Error 

END 

OPERATOR  Swap_Child 
SPECIFICATION 
INPUT 

The_Child  :  Positive, 

Of_The_Tree  :  Tree, 

And_The_Tree  ;  Tree 
OUTPUT 

Of_The_Tree  :  Tree, 

And_The_Tree  :  Tree 
EXCEPTIONS 


Overflow,  Tree^Is_Null,  Tree_Is_Not_Null ,  ChildLError 

END 

OPERATOR  Is^Egual 

SPECIFICATION 

INPUT 

Left  :  Tree, 

Right  :  Tree 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Tree_IsJMull,  Tree_Is_Not_Null ,  Child_Error 

END 

OPERATOR  Is^ull 

SPECIFICATION 

INPUT 

The_Tree  :  Tree 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Tree_Is_^ull ,  Tree_IsJlot_Null,  ChildLError 

END 

OPERATOR  Item_Of 

SPECIFICATION 

INPUT 

The_Tree  :  Tree 
OUTPUT 

Result  :  Item 
EXCEPTIONS 

Overflow,  Tree_Is_Null ,  Tree_IsLNot_Null ,  ChildLError 

END 

OPERATOR  NumberLOf_Children_In 

SPECIFICATION 

INPUT 

The_Tree  ;  Tree 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Tree_ISLNull,  TreeLlSLNot_Null,  ChildLError 

END 

OPERATOR  Child^Of 

SPECIFICATION 

INPUT 

The_Tree  :  Tree, 

TheLChild  :  Positive 
OUTPUT 

Result  ;  Tree 
EXCEPTIONS 

Overflow,  TreeLls^Null,  Tree_ISLNotLNull,  ChildLError 

END 

END 

IMPLEMENTATION  ADA  Tree_Arbitrary_Single_UnboundedLManaged 
END 
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TREE  ARBITRARY  SINGLE  UNBOUNDED  UNMANAGED 
ADA  SPECIFICATIONS 


generic 

type  Item  is  private; 

Expected_J^iiiriber_Of_Children  :  in  Positive; 
package  Tree,J^bitrary_Single_Unbounded^Uninanaged  is 


type  Tree 

is  private 

Null^Tree 

:  constant 

Tree  ; 

procedure 

Copy 

( Front.The_.Tre® 

in 

Tree; 

To_The_Tree 

in 

out 

Tree) ; 

procedure 

Clear 

(The^Tree 

in 

out 

Tree) ; 

procedure 

Construct 

(The^Item 

in 

Item; 

And_The_Tree 

in 

out 

Tree; 

Nuinber_Of_Children 

in 

Natural ; 

On_The_Child 

in 

Natural) ; 

procedure 

Set_Item 

(Of_The_Tree 

in 

out 

Tree; 

To_The_Item 

in 

Item)  ; 

procedure 

Swap_Child 

(The^Child 

in 

Positive; 

Of_The_Tree 

in 

out 

Tree; 

An<3LThe_Tree 

in 

out  Tree) ; 

—  modified  by  Tuan  Nguyen 

—  25  December  1995 

—  adding  procedures  to  replace  functions 


Result 

:  out  Item) ; 

procedure  Nuinber_Of_Children_In 

{The_Tree 

Result 

:  in  Tree; 

;  out  Natural) 

; 

procedure  Child_0f 

(The^Tree 
The_Child  : 

:  in  Tree ; 

I  in  Positive; 

Result 

:  out  Tree ) ; 

—  end  of  modification 

function  Is_Equal 

(Left 

Right 

;  in  Tree; 

;  in  Tree) 

return 

Boolean; 

function  IsJJull 

(The_Tree 

:  in  Tree) 

return 

Boolean; 

function  Item_0f 

(The_Tree 

:  in  Tree) 

return 

I  tern; 

function  Number_Of_Children_In 

(The_Tree 

:  in  Tree) 

return 

Natural ; 

function  Child_0f 

(The_Tree 
The_Child  : 

:  in  Tree; 

:  in  Positive) 

return 

Tree  7 


Overflow 

Tree_ls_Null 

Tree_Is_Not_Null 

Child_Error 


exception; 

exception; 

exception; 

exception; 


procedure  Is_Equal 

procedure  Is_Null 
procedure  Iten^Of 


(Left 
Right 
Result 
(The_Tree 
Result 
( The_Tree 


in  Tree; 
in  Tree; 
out  Boolean) ; 
in  Tree; 
out  Boolean) ; 
in  Tree) ; 


private 

type  Node; 

type  Tree  is  access  Node; 

Null_Tree  :  constant  Tree  :=  null; 
end  Tree,JVrbitrary_Single_Unbounded_Unmanaged ; 
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TREE  ARBITRARY  SINGLE  UNBOUNDED  UNMANAGED 


ADA  IMPLEMENTATION 


—  (C)  Copyright  1986,  1987,  1988,  1989,  1990  Grady  Booch 

—  All  Rights  Reserved 

—  Serial  Number  0100219 

•Restricted  Rights  Legend" 

—  Use,  duplication,  or  disclosure  is  subject  to 

—  restrictions  as  set  forth  in  subdivision  (b)  (3)  (ii) 

—  of  the  rights  in  Technical  Data  euid  Computer 

—  Software  Clause  of  FAR  52.227-7013.  Manufacturer: 

—  Wizard  software,  2171  S.  Parfet  Court,  Lakewood, 

—  Colorado  80227  (1-303-987-1874) 

with  Map_Siirple_Noncached„Sequential_Unbounded_Uninanaged„I terator  ; 
package  body  Tree_Arbitrary_Single_Unbounded_Unmanaged  is 

function  Hash^Of  (The^Child  :  in  Positive)  return  Positive; 


package  Children  is  new 

Map_Simple_NoncachedLSequential_Unbounded_Unmanaged_Iterator 
(Domain  =>  Positive, 

Ranges  =>  Tree, 

Number_Of_Buckets  »>  Expecte{Oluniber_0f_Children, 

Hash_0f  =>  Hasbro f) ; 

type  Node  is 
record 

The_It€m  :  Item; 

The_Children  :  Children.Map; 
end  record; 

function  Hash_Of  (The_Child  :  in  Positive)  return  Positive  is 
begin 

return  The_Child; 
end  Hash_Of; 


procedure  Copy  ( From_The_Tree  :  in  Tree; 

To_The_Tree  :  in  out  "^ee)  is 

procedure  Copy_Child  (The^Domain  :  in  Positive; 

The_Ramge  :  in  Tree; 

Continue  ;  out  Boolean)  is 

Temporary_Node  :  Tree; 
begin 

Copy(The_Range,  To_The_Tree  =>  TenporaryJMode)  ; 

Chi Idren . Bind ( The_Domain ,  Tenporary_Node , 

In_The_Map  =>  To_The_Tree.The_Children)  ; 
Continue  :=  True; 
end  Copy^Child; 

procedure  Copy„Children  is  new  Children. Iterate ( Copy_Child) ; 
begin 

if  Froin_The_Tree  =  null  then 
To_The_Tree  :=  null; 

else 

To_The_Tree  ;=  new  Node; 

To_The_Tree . The_Item  :=  From_The_Tree.The_Item; 

Copy_Chi Idren ( Fr om_The_Tree . The_Chi Idren ) ; 
end  if; 
exception 

when  Storage_Error  }  Chi Idren. Over flow  => 
raise  Overflow; 
end  Copy; 


procedure  Clear  (The_Tree  :  in  out  Tree)  is 
Isegin 

The_Tree  ;=  null; 
end  Clear; 


procedure  Construct  (The_Item  :  in  I tern; 

AncLThe^Tree  :  in  out  Tree; 

Number_Of_Children  :  in  Natural; 

On_The_Child  ;  in  Natural) 

Teiiporary_Node  :  Tree  ; 
loegin 

if  Number_Of_Chi Idren  =  0  then 
if  AndLThe_Tree  =  null  then 
And_The_Tree  :=  new  Node; 
And_The^Tree.The_Item  :=  The_Item; 


return; 

else 

raise  Tree_IsJ6lot_JJull; 
end  if; 

elsif  On_The_Child  >  Number^Of .Children  then 
raise  Child.Error ; 

else 

Temporary.Node  :=  new  Node; 

Tenporary_>Iode .  The.I  t em  :  =  The.I  tern ; 
for  Index  in  1  . .  Number.Of .Children  loop 
if  Index  =  On.The.Child  then 
Chi Idren. Bind 

(The.Domain  =>  Index, 

And.The.Range  =>  And_The.Tree , 

In.TheJiap  =>  Temporary_Node.The.Children)  ; 

else 


Chi Idren. Bind 

( The.Domain  ==> 
And^TheJRange  => 
In_The_Map  => 


Index, 

null, 

TerrporaryJMode.The.Children) ; 


end  if; 
end  loop; 

And.The.Tree  :=  Teinporary_JIode ; 
end  if; 
exception 

when  Storage.Error  |  Children. Overflow  => 
raise  Overflow; 
end  Construct; 

procedure  Set.Item  (Of.The.Tree  :  in  out  Tree; 

To.The.Item  :  in  Item)  is 

begin 

Of.The_Tree.The.Item  :=  To.The.Item; 
exception 

when  Constraint.Error  => 
raise  Tree.Is_Null; 
end  Set.Item; 

procedure  Swap.Child  (The.Child  :  in  Positive; 

Of.The.Tree  :  in  out  Tree; 

And.The.Tree  ;  in  out  Tree)  is 
Tenporary.Node  :  Tree ; 
begin 

Temporary JMode  :=  Children.Range.Of 

(The.Domain  =>  The.Child, 

In.TheJlap  =>  Of. The.Tree.The.Chi Idren) 
Chi  Idren.  Unbind  (The.Child,  Of.The.Tree.The.Children)  ; 

Chi Idren. Bind (The.Domain  =>  The.Child, 

And.The.Range  :=>  And.The.Tree, 

In_TheJMap  =>  Of.The.Tree.The.Children); 
And.The.Tree  :  =  Tentporary.Node ; 
exception 

when  Constraint.Error  => 

raise  Tree.IsJIull; 
when  Children. Domain.IsJJot.Bound  => 
raise  Child.Error; 
end  Swap.Child; 

—  modified  by  Tuan  Nguyen 

—  25  December  1995 

—  adding  procedures  to  replace  functions 

procedure  Is.Equal  (Left 

Right 
Result 

begin 

Result  Is.Equal (Left, Right) ; 

end  Is.Equal; 

procedure  Is^ull  (The.Tree 

Result 

begin 

Result  :=  Is.Null (The.Tree) ; 
end  Is.Null; 

procedure  Item.0f  (The.Tree 

Result 

begin 

Result  ; =  I t em.Of ( The.Tree ) ; 
end  ItenuOf; 

procedure  Number_Of_Children.In  (The.Tree 

Result 

begin 

Result  :=  Number.Of.Children.In (The.Tree } ; 
end  Nuniber.Of.Children.In; 

procedure  ChildjOf  (The.Tree  :  in  Tree; 

The.Child  :  in  Positive; 

Result  :  out  Tree)  is 

begin 

Result  : *  Chi ld.Of ( The.Tree , The.Chi Id ) ; 
end  Chi ld.Of; 

—  end  of  modification 


:  in  Tree ; 

:  in  Tree ; 

:  out  Boolean)  is 


:  in  Tree ; 

:  out  Boolecui)  is 


:  in  Tree) ; 

;  out  Item)  is 


:  in  Tree; 

:  out  Natural)  is 


function  Is.Equal  (Left  :  in  Tree; 

Right  :  in  Tree)  return  Boolezm  is 
Trees_Are.Equal  :  Boolean  :=  True; 

procedure  Check.Child_Equality  (The.Domain  :  in  Positive; 

The.Range  :  in  Tree ; 

Continue  :  out  Boolean)  is 


begin 

if  not  Is.Equal {The.Range, 

Children.Range.Of (The.Domain, 

Right .The.Chi Idren) ) 

then 

Trees.Are.Equal  :=  False; 

Continue  :=  False; 

else 

Continue  :«  True; 
end  if; 

end  Check.Child.Equality; 
procedure  Check.Equality  is  new 
Children. Iterate (Check.Child.Equality) ; 
begin 

if  Lef t .The.Item  /=  Right .The.Item  then 
return  False; 
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if  Children. Extent_Of (Left .The_Children)  /= 
Children, Extent_Of (Right .The_Children)  then 
return  False; 

else 

Check_Equality(Left .The_Children) ; 
return  Trees_^e_Equal; 
end  if; 
end  if; 
exception 

when  Constraint_Error  => 

return  (Left  =  Null_Tree)  and  (Right  =  Null^Tree) ; 
end  Is_Equal; 

function  Is^Null  (The_Tree  :  in  Tree)  return  Boolean  is 
begin 

return  (The^Tree  null) ; 
end  Is_JNull; 

function  ItenuOf  (The_Tree  :  in  Tree)  return  Item  is 
begin 

return  The_Tree.The_Item; 
exception 

when  Constraint_Error  => 
raise  Tree_Is_Null; 


end  ItenuOf; 

function  Nuinber_Of_Children_In  (The^Tree  : 
is 

begin 

return  Children . Extent_Of (The_Tree . The_ 
exception 

when  Constraint„Error  => 
raise  Tree_Is_Null ; 
end  Nuinber_Of_,Children_In; 

function  Child^Of  (The_Tree  :  in  Tree; 

The^Child  :  in  Positive) 

begin 

return  Children. Range_Of{The_Doinain  => 
In^The_Map  => 

exception 

when  Constraint_Error  => 

raise  Tree_Is_Null; 
when  Children.Doinain_IsJWot_Bound  => 
raise  Child_Error; 
end  Child_Of; 

end  Tre  e_^bi  t rary_S  ing  le_UnboundecLUnmanaged  ; 


in  Tree)  return  Natural 
.Children)  ; 

return  Tree  is 
The_Child, 

The_Tree .  The_Children )  ; 
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TREE  ARBITRARY  SINGLE  UNBOUNDED  UNMANAGED 


TYPE  Tree_Arbitrary_Single_UnboundedLUnmanaged 
SPECIFICATION 
GENERIC 

Item  ;  PRIVATE_TYPE 
OPERATOR  Copy 
SPECIFICATION 
INPUT 

Fron\_The_Tree  :  Tree, 

To_The_Tree  :  Tree 
OUTPUT 

To_The_Tree  :  Tree 
EXCEPTIONS 

Overflow,  Tree_Is_Null,  Tree_IsJ^ot_Null,  ChilcLError 

END 


OPERATOR  Clear 
SPECIFICATION 
INPUT 

The^Tree  :  Tree 
OUTPUT 

The_Tree  :  Tree 
EXCEPTIONS 

Overflow,  Tree_Is_Null ,  Tree_Is_NotJNull,  Child_Error 

END 


OPERATOR  Construct 
SPECIFICATION 
INPUT 

The_ltem  :  Item, 

And_The„Tree  :  Tree , 

Number_Of_Children  :  Natural, 

On_The_Child  :  Natural 
OUTPUT 

And^The_Tree  :  Tree 
EXCEPTIONS 

Overflow,  Tree_Is_Null,  Tree_Is_Not_Null,  Child^Error 

END 


OPERATOR  Set_Item 
SPECIFICATION 
INPUT 

Of_The_Tree  :  Tree , 

To_The_Item  :  Item 
OUTPUT 

Of_The_Tree  ;  Tree 
EXCEPTIONS 

Overflow,  Tree_IsJNull ,  Tree_Is_Not_Null,  Child_Error 

END 

OPERATOR  Swap^Child 
SPECIFICATION 
INPUT 

The_Child  ;  Positive, 

Of_The_Tree  :  Tree, 

And^The_Tree  :  Tree 
OUTPUT 

Of _The_Tree  :  Tree , 

And_The_Tree  :  Tree 
EXCEPTIONS 


PSDL 


Overflow,  Tree^Is^ull,  Tree_Is_JNot^ull,  Child_Error 

END 


OPERATOR  Is_Equal 
SPECIFICATION 
INPUT 

Left  :  Tree, 

Right  :  Tree 
OUTPUT 

Result  :  Boolean 
EXCEPTIONS 

Overflow,  Tree_Is_Null,  Tree_Is_Not_Null ,  ChilcLError 

END 


OPERATOR  Is_Null 
SPECIFICATION 
INPUT 

The_Tree  ;  Tree 
OUTPUT 

Result  ;  Boolean 
EXCEPTIONS 

Overflow,  Tree_Is_Null,  Tree_Is_Not JMull ,  ChildLError 

END 


OPERATOR  ItenuOf 

SPECIFICATION 

INPUT 

The_Tree  :  Tree 
OUTPUT 

Result  :  Item 
EXCEPTIONS 

Overflow,  Tree_IsJNull,  Tree_Is_Not JNull ,  Child-Error 

END 

OPERATOR  Nxamber_Of_Children_In 

SPECIFICATION 

INPUT 

The^Tree  :  Tree 
OUTPUT 

Result  :  Natural 
EXCEPTIONS 

Overflow,  Tree_Is_Null,  Tree_ls_Not_Null ,  Chil<L.Error 

END 

OPERATOR  Child_Of 

SPECIFICATION 

INPUT 

The_Tree  :  Tree, 

The_Child  :  Positive 
OUTPUT 

Result  ;  Tree 
EXCEPTIONS 

Overflow,  Tree_Is_Null,  Tree_Is_Not_Null,  Child_Error 

END 

END 

IMPLEMENTATION  ADA  Tree-Arbitrary_Single_Unbounded_Unmanaged 
END 
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